home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / language / parallax / more_exa.tar / more / Fluids / lattice_gas.p < prev    next >
Text File  |  1992-08-28  |  126KB  |  3,808 lines
  1. (****************************************************************************)
  2. (***                                                                      ***)
  3. (***      Program ILG 1.0:                                                ***)
  4. (***            Programming Language Parallaxis                           ***)
  5. (***                                                                      ***)
  6. (***      Author : Stefan Kolmar                                          ***)
  7. (***      Begin  : Dezember 1991                                          ***)
  8. (***      End    : July     1992                                          ***)
  9. (***                                                                      ***)
  10. (***      Purpose: Program to simulate the kollision of fluids using      ***)
  11. (***                   the Lattice - Gas - Theory                         ***)
  12. (***                                                                      ***)
  13. (***                                                                      ***)
  14. (****************************************************************************)
  15.  
  16. system ilg_10;
  17.  
  18.  
  19.  
  20. const maxnet=128;          (* Dimensions of the physical grid -> number of    *)
  21.                            (* processing Elements of the used Computer        *)
  22.                            (* MasPar: 16384 = 128 x 128 Processors            *)
  23.       schnappschussausgabe = 'data/bilb0000.dat';    (* saving snapshot outp. *)
  24.       rotblauausgabe       = 'data/rotblae0000.dat'; (* 2-bit Rasterfiles     *)
  25.       vektorausgabe        = 'data/vector0000.vff';  (* Vectorplots           *)
  26.       aufsetzerfile        = 'data/wo.dat';          (* loading snapshot-file *)
  27.       inputfile            = 'galin.input';          (* Inputfile             *)
  28.       controlfile          = 'data/control.dat';     (* controlfile           *)
  29.       virtuellepesx = 256;                   virtuellepesy = 256;
  30.       vfaktx = virtuellepesx div maxnet;     vfakty = virtuellepesy div maxnet;
  31.       vfakt = vfaktx*vfakty;
  32.       iruh = 1;             (* number of particels without velocity *)
  33.       offset15 = 2**15;                     offset4  = 2**4;
  34.       offset6  = 2**6;
  35.       wurzel3durch4 = sqrt(3.)/4.;          wurzeldreidurch2 = sqrt(3.)/2.;
  36.       (* Zuordnungstabellen :*)
  37.         file1='tes70000.dat';   file1l=436;   (*  tes70000.dat -> 436 Lines*)
  38.         file2='tes70001.dat';   file2l=393;   (*  tes70001.dat -> 393 Lines*)
  39.         file3='tes70003.dat';   file3l=565;   (*  tes70003.dat -> 565 Lines*)
  40.         file4='tes70004.dat';   file4l=393;   (*  tes70004.dat -> 393 Lines*)
  41.       Impulstabelle      = 'table.impulse';
  42.       Zuordtabelle       = 'table.points';        
  43.       Teilchentabelle    = 'table.parts';
  44.       Kollisionstabelle1 = 'colt0000.dat'; 
  45.       Kollisionstabelle2 = 'colt0001.dat'; 
  46.       Kollisionstabelle3 = 'colt0003.dat';  
  47.       Kollisionstabelle4 = 'colt0004.dat';                   
  48.       ausrechtsov = max(cardinal) - 3087;  ausrechtsmv = max(cardinal) - 3; 
  49.       auslinksmv  = max(cardinal) - 1008;  auslinksov = max(cardinal) - 192;
  50.       ausulein =  max(cardinal) - 48;      ausulro  =  max(cardinal) - 12;
  51.       ausulru  =  max(cardinal) - 60;      ausolein =  max(cardinal) - 768;
  52.       ausoro   =  max(cardinal) - 3072;    ausoru   =  max(cardinal) - 3840;
  53.       maxAnzahlblasen = 5;   
  54.  
  55.  
  56. type impulstyp = record 
  57.                     impuls_x : integer;
  58.                     impuls_y : integer;
  59.                  end;
  60.      vectortyp = record
  61.                     x_Richtung : real;
  62.                     y_Richtung : real;
  63.                  end;
  64.      card10    = array[1..10] of cardinal;
  65.      real10    = array[1..10] of real;
  66.      zustandstyp = array [0..895] of cardinal;
  67.      kolfeldtyp  = array [0..3],[1..180] of cardinal;
  68.      teilimptyp  = array [1..19],[1..36] of cardinal;
  69.      impulsfeldtyp = array [-4..4],[-2..2] of cardinal;
  70.      teilchenfeldtyp = array [0..7],[0..7] of cardinal;
  71.      stringtyp = array [1..16] of char;
  72.      string80  = array [1..80] of char;
  73.      string10  = array [1..10] of char;
  74.      rotblauteilchentyp = array[1..vfakt] of cardinal;
  75.  
  76.  
  77.  
  78.  
  79.  
  80. configuration hexagon[maxnet],[maxnet];
  81.  
  82.  
  83.  
  84. connection 
  85.  
  86.      rechts:       hexagon[i,j] -> hexagon[i               ,(j+1) mod maxnet             ].links;
  87.      links :       hexagon[i,j] -> hexagon[i               ,(j-1) mod maxnet             ].rechts;
  88.      oben_links:   hexagon[i,j] -> hexagon[(i+1) mod maxnet,(j- i mod 2) mod maxnet      ].unten_rechts;
  89.      unten_links:  hexagon[i,j] -> hexagon[(i-1) mod maxnet,(j- i mod 2) mod maxnet      ].oben_rechts;
  90.      oben_rechts:  hexagon[i,j] -> hexagon[(i+1) mod maxnet,(j+ 1 - i mod 2) mod maxnet  ].unten_links;
  91.      unten_rechts: hexagon[i,j] -> hexagon[(i-1) mod maxnet,(j+ 1 - i mod 2) mod maxnet  ].oben_links;
  92.  
  93.  
  94. (* global arrays : *)
  95. vector Rote_Blaue_Teilchen,                (* the real net with the nodes                        *)
  96.        anzahlrotblau : rotblauteilchentyp; (* the number of red and blue particels in one node   *)
  97.        zustandstaball : zustandstyp;       (* global statetable                                  *)
  98.        kolfeldall  : kolfeldtyp;           (* global collisionstable                             *)
  99.        teilimpfeldall : teilimptyp;        (* table representing particle x Impuls -> number     *)
  100.        impulsfeldall : impulsfeldtyp;      (* Impulsx x Impulsy -> number                        *)
  101.        teilchenfeldall : teilchenfeldtyp;  (* red particles x blue particles   -> number         *)
  102.  
  103.  
  104.  
  105. scalar zaehlerglobal,                 anzahlblasen,
  106.        flaechen,                      anfangszeitpunkt,
  107.        endzeitpunkt,                  bildabstand,
  108.        anzahlgemitteltx,              anzahlgemittelty,
  109.        bildabstandgesch,              erstesbild,
  110.        erstesbildgesch                                : cardinal;
  111.        filestring                                     : string80;
  112.        filezaehlers,                  filezaehlerrb,
  113.        filezaehlerv,                  filezaehlerhilf : [0..9999];
  114.        handle                                         : integer;
  115.        geschwu0,                      geschwv0,
  116.        reddichte,                     anteilrot       : real;
  117.        geschwx,                       geschwy,
  118.        dichtebl,                      dichteblr,
  119.        geschwxr,                      geschwyr        : real10;       
  120.        radius,                        mittelpunktx,
  121.        mittelpunkty,                  rechtecklinksuntenx,
  122.        rechtecklinksunteny,           rechteckseitea,
  123.        rechteckseiteb                                 : card10;
  124.        randoben,                      randunten,
  125.        randrechts,                    randlinks       : string10;
  126.  
  127.  
  128.  
  129.  
  130.  
  131. (****************************************************************************)
  132. (***                                                                      ***)
  133. (***      Funktion BitwiseUND  :                                          ***)
  134. (***              implements the Bitwise AND function                     ***)
  135. (***                                                                      ***)
  136. (****************************************************************************)
  137.  
  138.  
  139. procedure BitwiseUnd (vector a,b,wieweit : cardinal): vector cardinal;
  140.  
  141.   vector  hilf,               faktor,
  142.           zaehler                   : cardinal;
  143.  
  144.  
  145.   begin
  146.     
  147.      faktor :=1;
  148.      hilf   :=0;
  149.  
  150.      for zaehler:=1 to wieweit+1 do
  151.       
  152.          if ( odd(a) and odd(b) ) then
  153.                                    hilf := hilf + faktor;
  154.                                   end;
  155.          faktor := faktor + faktor;
  156.          a := a div 2;
  157.          b := b div 2;
  158.      end;
  159.      return(hilf);
  160.   end BitwiseUnd;
  161.  
  162.  
  163.  
  164.  
  165.  
  166.  
  167. (****************************************************************************)
  168. (***                                                                      ***)
  169. (***      Funktion BitwiseOder  :                                         ***)
  170. (***              implements the Bitwise OR function                      ***)
  171. (***                                                                      ***)
  172. (****************************************************************************)
  173.  
  174.  
  175. procedure BitwiseOder (vector a,b : cardinal): vector cardinal;
  176.  
  177.   vector  hilf,                 faktor,
  178.           zaehler                     : cardinal;
  179.  
  180.  
  181.   begin
  182.     
  183.      faktor :=1;
  184.      hilf   :=0;
  185.  
  186.      for zaehler:=1 to 14 do
  187.       
  188.          if ( odd(a) or odd(b) )  then
  189.                                    hilf := hilf +faktor;
  190.                                   end;
  191.          faktor := faktor +faktor;
  192.          a := a div 2;
  193.          b := b div 2;
  194.      end;
  195.      return(hilf)
  196.   end BitwiseOder;
  197.  
  198.  
  199.  
  200.  
  201.  
  202.  
  203.  
  204.  
  205. (****************************************************************************)
  206. (***                                                                      ***)
  207. (***      Funktion BitwiseXor :                                           ***)
  208. (***              implements the Bitwise XOR function                     ***)
  209. (***                                                                      ***)
  210. (****************************************************************************)
  211.  
  212.  
  213. procedure BitwiseXor (vector a,b : cardinal): vector cardinal;
  214.  
  215.   vector  hilf,               faktor,
  216.           zaehler                   : cardinal;
  217.  
  218.  
  219.   begin
  220.  
  221.      faktor :=1;
  222.      hilf   :=0;
  223.  
  224.      for zaehler:=1 to 14 do
  225.       
  226.          if (( odd(a) or odd(b) ) and not ( odd(a) and odd(b) ))  
  227.                                   then
  228.                                    hilf := hilf +faktor
  229.                                   end;
  230.          faktor := faktor * 2;
  231.          a := a div 2;
  232.          b := b div 2;
  233.      end;
  234.      return(hilf);
  235.   end BitwiseXor;
  236.  
  237.  
  238.  
  239. (*****************************************************************************)
  240. (***                                                                       ***)
  241. (***     Prozedur anfangsbelegung :                                        ***)
  242. (***             implements the initial net                                ***)
  243. (***             In a file the values of                                   ***)
  244. (***              anteilrot, geschwu0, geschwv0, geschwv, faktor,          ***)
  245. (***              dichtebewteil, dichteruheteil, gesamtdichte              ***)
  246. (***             are loaded and the initial values will be set             ***)
  247. (***                                                                       ***)
  248. (*****************************************************************************)
  249.  
  250. procedure anfangsbelegung(scalar anzahlblasen,flaechen:cardinal;
  251.            scalar geschwu,geschwv,reddichte,anteilrote : real;
  252.            scalar geschwx,geschwy,dichtebl : real10;
  253.            scalar radius,mittelpunktx,mittelpunkty : card10;
  254.            scalar randoben,randunten,randrechts,randlinks : string10;
  255.            scalar rechtecklinksuntenx,rechtecklinksunteny,rechteckseitea,rechteckseiteb : card10;
  256.            scalar dichteblr,geschwxr,geschwyr : real10);
  257.  
  258.   
  259.    vector  faktor : real;     
  260.            
  261.            vektoranf : record 
  262.                            anfangsbel0 : real;           
  263.                            anfangsbel1 : real;
  264.                            anfangsbel2 : real;
  265.                            anfangsbel3 : real; 
  266.                            anfangsbel4 : real;
  267.                            anfangsbel5 : real; 
  268.                            anfangsbel6 : real;
  269.                         end;
  270.  
  271.              vrot : record 
  272.                         r0 : real;
  273.                         r1 : real;
  274.                         r2 : real;
  275.                         r3 : real;
  276.                         r4 : real;
  277.                         r5 : real;
  278.                         r6 : real;
  279.                      end;
  280.  
  281.              zufall,       zufallnorm,
  282.              anteilrot                                : real;
  283.              zaehler1,     zaehler2,      zaehler3    : integer;
  284.              offsetv                                  : cardinal;
  285.              hilfbool1,    hilfbool2,     hilfbool3,
  286.              hilfbool4,    kein_rand                  : boolean;
  287.  
  288.  
  289.    scalar radiusy               : array[1..maxAnzahlblasen] of cardinal;
  290.           zaehlerscal           : cardinal;
  291.           xpos,                 ypos                  : card10;
  292.           blase,                entmischung,   
  293.           rechteck,             rand                  : boolean;
  294.   vector  geschwu0,             geschwv0              :real;
  295.  
  296.  
  297.     begin
  298.  
  299.    (* setting variables  *)
  300.  
  301.       (* Initialize *)
  302.       blase       := false;            rechteck := false;
  303.       entmischung := true;
  304.       
  305.       if anzahlblasen>0 then blase := true;
  306.                              entmischung := false;end;
  307.       if flaechen>0 then rechteck := true;
  308.                          entmischung := false;end;
  309.       
  310.       if blase then
  311.            for zaehlerscal := 1 to Anzahlblasen do
  312.                    radiusy[zaehlerscal] := trunc(float(radius[zaehlerscal]) / (0.5 * sqrt(3.)));
  313.                xpos[zaehlerscal] := mittelpunktx[zaehlerscal];
  314.                ypos[zaehlerscal] := mittelpunkty[zaehlerscal];
  315.            end;
  316.       end;
  317.  
  318.  
  319.       parallel
  320.  
  321.         anteilrot := anteilrote;
  322.         geschwu0 := geschwu;
  323.         geschwv0 := geschwv;
  324.  
  325.            
  326.         offsetv := 0;
  327.         
  328.         
  329.         for zaehler1 := 1 to vfakty do
  330.  
  331.           for zaehler2 := 1 to vfaktx do
  332.  
  333.  
  334.             (* droplet *)
  335.             (* Ellipsenformel:
  336.                x**2/a**2 + y**2/b**2 <= 1 *)
  337.             if blase then
  338.                anteilrot := 1.;
  339.                geschwu0 := 0.;
  340.                geschwv0 := 0.;
  341.                reddichte := dichtebl[1];
  342.                for zaehlerscal:=1 to anzahlblasen do
  343.                    if (float(DIM1+((vfakty-zaehler1)*maxnet)-ypos[zaehlerscal])**2 
  344.                            / float(radiusy[zaehlerscal])**2 
  345.                       + float(DIM2+((zaehler2-1)*maxnet)-xpos[zaehlerscal])**2 
  346.                           / float(radius[zaehlerscal])**2 <= 1.) then
  347.                       geschwu0 := geschwx[zaehlerscal];
  348.                       geschwv0 := geschwy[zaehlerscal];
  349.                       anteilrot := 0.;
  350.                       reddichte := dichtebl[zaehlerscal];
  351.                    end;
  352.                end;
  353.             end;
  354.  
  355.  
  356.  
  357.             (* Rechteck *)
  358.             if rechteck then
  359.                anteilrot := 1.;
  360.                geschwu0:=0.;
  361.                geschwv0:=0.;
  362.                reddichte := dichteblr[1];
  363.                for zaehlerscal:=1 to flaechen do
  364.                    if ((0 <= (dim2)+((zaehler2-1)*maxnet) <= rechtecklinksuntenx[zaehlerscal]) 
  365.                         or ((rechtecklinksuntenx[zaehlerscal] + rechteckseitea[zaehlerscal]) 
  366.                         <= ((dim2)+((zaehler2-1)*maxnet)) <= virtuellepesx) 
  367.                       or (0 <= (dim1)+((vfakty-zaehler1)*maxnet) 
  368.                             <= rechtecklinksunteny[zaehlerscal]) 
  369.                           or (rechtecklinksunteny[zaehlerscal]+rechteckseiteb[zaehlerscal]
  370.                           <= (dim1)+((vfakty-zaehler1)*maxnet) <= virtuellepesy)) then
  371.                           geschwu0 := geschwxr[zaehlerscal];
  372.                           geschwv0 := geschwyr[zaehlerscal];
  373.                           reddichte := dichteblr[zaehlerscal];
  374.                           anteilrot := 0.;
  375.                    end;
  376.                end; 
  377.             end;
  378.             
  379.       
  380.  
  381.            faktor := 2. * (float(iruh) + 6. ) / 6.;
  382.  
  383.            vektoranf.anfangsbel0 := reddichte;
  384.            vektoranf.anfangsbel1 := reddichte * 
  385.                           ( 1.0 + faktor * geschwu0);
  386.            vektoranf.anfangsbel2 := reddichte * 
  387.                           ( 1.0 + faktor * (geschwu0*0.5 + geschwv0 * wurzeldreidurch2));
  388.            vektoranf.anfangsbel3 := reddichte * 
  389.                           ( 1.0 + faktor * (-geschwu0*0.5 + geschwv0 * wurzeldreidurch2));
  390.            vektoranf.anfangsbel4 := reddichte * 
  391.                           ( 1.0 - faktor * geschwu0);
  392.            vektoranf.anfangsbel5 := reddichte * 
  393.                           ( 1.0 - faktor * (geschwu0*0.5 + geschwv0 * wurzeldreidurch2));
  394.            vektoranf.anfangsbel6 := reddichte * 
  395.                           ( 1.0 + faktor * (geschwu0*0.5 - geschwv0 * wurzeldreidurch2));
  396.  
  397.  
  398.  
  399.             vrot.r0 := vektoranf.anfangsbel0 * anteilrot;
  400.             vrot.r1 := vektoranf.anfangsbel1 * anteilrot;
  401.             vrot.r2 := vektoranf.anfangsbel2 * anteilrot;
  402.             vrot.r3 := vektoranf.anfangsbel3 * anteilrot;
  403.             vrot.r4 := vektoranf.anfangsbel4 * anteilrot;
  404.             vrot.r5 := vektoranf.anfangsbel5 * anteilrot;
  405.             vrot.r6 := vektoranf.anfangsbel6 * anteilrot;
  406.  
  407.  
  408.           
  409.             zaehler3 := zaehler2+offsetv;
  410.             Rote_Blaue_Teilchen[zaehler3]  := 0;
  411.   
  412.  
  413.  
  414.            (* anfangsbelegungX : Wahrscheinlichkeit, dass eine Zelle belegt ist *)
  415.            (* Anteilrot : wird vorgegeben                                       *)
  416.            (* Algorithmus : Ist anfangsbelegungX > erzeugte Zufallszahl ?       *)
  417.            (*                 Ja : Zelle wird mit einem Teilchen besetzt        *)
  418.            (*                      vrot.rX > Zufallszahl ?                      *)
  419.            (*                                  Ja : Zelle mit Rot belegen       *)
  420.            (*                                Nein : Zelle mit Blau belegen      *)
  421.            (*   Belegung des 32 - Bit Wortes Rote_Blaue_Teilchen :              *)
  422.            (*    |--|--|r0|b0|r6|b6|r5|b5|r4|b4|r3|b3|r2|b2|r1|b1|              *)
  423.  
  424.  
  425.            (* Parallel fuer jedes PE eine Zufallszahl erzeugen  *)
  426.  
  427.            hilfbool1 := (DIM1<>0) or (zaehler3 <= (vfakt-vfaktx)) or (randunten='RING');
  428.            hilfbool2 := (DIM1<>maxnet-1) or (zaehler3>= vfaktx) or (randoben='RING');
  429.            hilfbool3 := (DIM2<>0) or (zaehler3 mod vfaktx<>1) or (DIM1 mod 2 = 1)  
  430.                          or (randlinks='RING');
  431.            hilfbool4 := (DIM2<>maxnet-1) or (zaehler3 mod vfaktx<>0)  or (DIM1 mod 2 = 1) 
  432.                          or (randrechts='RING');
  433.  
  434.            
  435.            if (hilfbool1 and hilfbool2 and hilfbool3 and hilfbool4) then
  436.  
  437.                       zufall := vrrandom();
  438.                       zufall := zufall / float(max(cardinal)); 
  439.  
  440.  
  441.                       if vektoranf.anfangsbel0 > zufall then
  442.                          if vrot.r0 > zufall 
  443.                             then Rote_Blaue_Teilchen[zaehler3]  := 
  444.                                             Rote_Blaue_Teilchen[zaehler3]+8192; 
  445.                             else Rote_Blaue_Teilchen[zaehler3]  := 
  446.                                             Rote_Blaue_Teilchen[zaehler3]+4096;
  447.                          end;
  448.                       end;
  449.            end;
  450.  
  451.  
  452.            if hilfbool4 then
  453.                             
  454.                       zufall := vrrandom(); 
  455.                       zufall := zufall / float(max(cardinal)); 
  456.  
  457.           
  458.                       if vektoranf.anfangsbel1 > zufall then
  459.                          if vrot.r1 > zufall 
  460.                             then Rote_Blaue_Teilchen[zaehler3] := 
  461.                                             Rote_Blaue_Teilchen[zaehler3]+2; 
  462.                             else Rote_Blaue_Teilchen[zaehler3] := 
  463.                                             Rote_Blaue_Teilchen[zaehler3]+1;
  464.                          end;    
  465.                       end;
  466.             end;
  467.  
  468.  
  469.             if (hilfbool3 and hilfbool4) then
  470.  
  471.                        zufall := vrrandom();
  472.                        zufall := zufall / float(max(cardinal));
  473.  
  474.     
  475.                        if vektoranf.anfangsbel2 > zufall then
  476.                           if vrot.r2 > zufall 
  477.                              then Rote_Blaue_Teilchen[zaehler3] := 
  478.                                              Rote_Blaue_Teilchen[zaehler3]+8; 
  479.                              else Rote_Blaue_Teilchen[zaehler3] := 
  480.                                              Rote_Blaue_Teilchen[zaehler3]+4;
  481.                           end;
  482.                        end;
  483.             end;
  484.  
  485.  
  486.             if (hilfbool2 and hilfbool3) then
  487.  
  488.                        zufall := vrrandom();
  489.                        zufall := zufall / float(max(cardinal));
  490.  
  491.  
  492.                        if vektoranf.anfangsbel3 > zufall then
  493.                           if vrot.r3 > zufall 
  494.                              then Rote_Blaue_Teilchen[zaehler3] := 
  495.                                              Rote_Blaue_Teilchen[zaehler3]+32;
  496.                              else Rote_Blaue_Teilchen[zaehler3] :=
  497.                                              Rote_Blaue_Teilchen[zaehler3]+16;
  498.                           end;
  499.                        end;
  500.             end; 
  501.  
  502.  
  503.  
  504.             
  505.             if hilfbool3 then
  506.  
  507.                        zufall := vrrandom();
  508.                        zufall := zufall / float(max(cardinal));
  509.  
  510.  
  511.                        if vektoranf.anfangsbel4 > zufall then
  512.                           if vrot.r4 > zufall 
  513.                              then Rote_Blaue_Teilchen[zaehler3] := 
  514.                                              Rote_Blaue_Teilchen[zaehler3]+128; 
  515.                              else Rote_Blaue_Teilchen[zaehler3] := 
  516.                                              Rote_Blaue_Teilchen[zaehler3]+64;
  517.                          end;
  518.                        end;
  519.             end;
  520.  
  521.  
  522.             if (hilfbool3 and hilfbool1) then
  523.  
  524.                        zufall := vrrandom();
  525.                        zufall := zufall / float(max(cardinal));
  526.  
  527.  
  528.                        if vektoranf.anfangsbel5 > zufall then
  529.                           if vrot.r5 > zufall 
  530.                              then Rote_Blaue_Teilchen[zaehler3] := 
  531.                                              Rote_Blaue_Teilchen[zaehler3]+512; 
  532.                              else Rote_Blaue_Teilchen[zaehler3] := 
  533.                                              Rote_Blaue_Teilchen[zaehler3]+256;
  534.                           end;
  535.                        end;
  536.             end;
  537.  
  538.  
  539.             if (hilfbool1 and hilfbool4) then
  540.  
  541.                        zufall := vrrandom();
  542.                        zufall := zufall / float(max(cardinal));
  543.  
  544.  
  545.                        if vektoranf.anfangsbel6 > zufall then
  546.                           if vrot.r6 > zufall 
  547.                              then Rote_Blaue_Teilchen[zaehler3] :=
  548.                                              Rote_Blaue_Teilchen[zaehler3]+2048;  
  549.                              else Rote_Blaue_Teilchen[zaehler3] := 
  550.                                              Rote_Blaue_Teilchen[zaehler3]+1024;
  551.                           end;
  552.                        end;
  553.              end;
  554.  
  555.           end; (* for *)
  556.           offsetv := offsetv + vfaktx;
  557.  
  558.         end (* for *)
  559.           
  560.      endparallel;
  561.  
  562.  
  563.  
  564.  
  565.   end anfangsbelegung;
  566.  
  567.  
  568.  
  569.  
  570.  
  571.  
  572.  
  573.  
  574. (***************************************************************************)
  575. (***                                                                     ***)
  576. (***     Prozedur Fortbewegung                                           ***)
  577. (***              implements the migration in the net                    ***)
  578. (***                                                                     ***)
  579. (***************************************************************************)
  580.  
  581.  
  582.  
  583. procedure fortbewegung;
  584.  
  585.  
  586.   vector uebergabeteilchen ,             ausblenden,
  587.          besetzt,                        belegt,
  588.          offsetv,                        zaehler1,
  589.          zaehler2,                       shiftchar,
  590.          shiftchar2x,                    uebergabenetz,
  591.          index,                          indexold,
  592.          indexh,                         indexhold,
  593.          obereGr,                        untereGr              : cardinal;
  594.          zaehlerfort,                    zaehlerfort1          : integer;
  595.          hilfrotblau           : array[1..vfakt] of cardinal;
  596.   
  597.  
  598.  
  599.   begin
  600.     
  601.  
  602.     parallel
  603.  
  604.  
  605.  
  606.        zaehlerfort1 := 1;
  607.  
  608.        for zaehler1 := 1 to vfaktx do
  609.          for zaehler2 := 1 to vfakty do
  610.     
  611.           uebergabenetz := 0;
  612.           uebergabeteilchen := 0;
  613.           shiftchar := 1;
  614.           shiftchar2x := 2 * shiftchar;
  615.               
  616.              
  617.           for zaehlerfort := 1 to 6 do
  618.  
  619.               if odd(Rote_Blaue_Teilchen[zaehlerfort1] div shiftchar)  then
  620.                  uebergabeteilchen := shiftchar;
  621.                  Rote_Blaue_Teilchen[zaehlerfort1] := Rote_Blaue_Teilchen[zaehlerfort1] - shiftchar;
  622.  
  623.               else if odd(Rote_Blaue_Teilchen[zaehlerfort1] div shiftchar2x) then
  624.                  uebergabeteilchen := shiftchar2x;
  625.                  Rote_Blaue_Teilchen[zaehlerfort1] := Rote_Blaue_Teilchen[zaehlerfort1] - shiftchar2x;end;
  626.               end;
  627.  
  628.               case shiftchar of
  629.                      1  : propagate.rechts(uebergabeteilchen) |
  630.                      4  : propagate.oben_rechts(uebergabeteilchen) |
  631.                     16  : propagate.oben_links(uebergabeteilchen) |
  632.                     64  : propagate.links(uebergabeteilchen) |
  633.                    256  : propagate.unten_links(uebergabeteilchen) |
  634.                   1024  : propagate.unten_rechts(uebergabeteilchen) ;
  635.               end;(* case *)
  636.      
  637.  
  638.             uebergabenetz:= uebergabenetz + uebergabeteilchen;
  639.             uebergabeteilchen := 0;
  640.             shiftchar := shiftchar * 4;
  641.             shiftchar2x := 2 * shiftchar;
  642.          
  643.              
  644.          end;(* for zaehlerfort*)
  645.  
  646.          (* Ruheteilchen bleiben *)
  647.          Rote_Blaue_Teilchen[zaehlerfort1] := Rote_Blaue_Teilchen[zaehlerfort1] + uebergabenetz;
  648.          inc(zaehlerfort1);
  649.  
  650.         end; (* for zaehler2 *)
  651.        end; (* for zaehler1*)
  652.  
  653.  
  654.  
  655.  
  656.    if (vfaktx >1) or (vfakty >1)  then
  657.    
  658.       (* Ausgleichen der Fortbewegung *)
  659.  
  660.       (* Initialize *)
  661.       for zaehler1:=1 to vfakt do
  662.           hilfrotblau[zaehler1] := 0;
  663.       end; (* for *) 
  664.         
  665.  
  666.       
  667.         offsetv := 0;
  668.         (* rechter Rand mit Versatz, r1b1r2b2r6b6 *)
  669.         if (DIM2 = 0) and (DIM1 mod 2 = 1) then
  670.           ausblenden := ausrechtsov;
  671.           besetzt := 3087;
  672.         end;
  673.         (* rechter Rand ohne Versatz, r1b1 *)
  674.         if (DIM2 = 0) and (DIM1 mod 2 = 0) then
  675.           ausblenden := ausrechtsmv;
  676.           besetzt := 3;
  677.         end;
  678. (*        (* rechter Rand untere Ecke, r1b1r2b2 *) 
  679.         if (DIM2 = 0) and (DIM1 = 0) then
  680.           ausblenden := max(cardinal) - 15;
  681.           besetzt := 15;
  682.         end;*)
  683.         (* linker Rand ohne Versatz, r3b3r4b4r5b5 *)
  684.         if (DIM2 = maxnet-1) and (DIM1 mod 2 = 0) then
  685.           ausblenden := auslinksmv; 
  686.           besetzt := 1008;
  687.         end;
  688.         (* linker Rand mit Versatz, r4b4 *)
  689.         if (DIM2 = maxnet-1) and (DIM1 mod 2 = 1) then
  690.           ausblenden := auslinksov; 
  691.           besetzt := 192; 
  692.         end;
  693. (*        (* linke obere Ecke, r4b4r5b5 *)
  694.         if (DIM2 = maxnet-1) and (DIM1 = maxnet-1) then
  695.           ausblenden := max(cardinal) - 960;
  696.           besetzt := 960;
  697.         end; *)
  698.   
  699.  
  700.         if (DIM2 = 0) or (DIM2 = maxnet-1) then
  701.           offsetv := 0;
  702.           for zaehlerfort := 1 to vfakty do
  703.             index := offsetv;
  704.             for zaehlerfort1 := 1 to vfaktx do
  705.                 inc(index);
  706.                 hilfrotblau[index] := BitwiseUnd(Rote_Blaue_Teilchen[index],besetzt,14);
  707.             end; (* for zaehlerfort1 *)
  708.             offsetv := offsetv + vfaktx;
  709.            end; (* for zaehlerfort *)
  710.         end; (* if *)
  711.  
  712.         (* rechter Rand *)
  713.         offsetv := 0;
  714.         if (DIM2 = 0) then
  715.           untereGr := 2;
  716.           obereGr := vfaktx;
  717.         end;
  718.         (* linker Rand *)
  719.         if (DIM2 = maxnet-1) then
  720.           untereGr := 1;
  721.           obereGr := vfaktx-1;
  722.         end;
  723.  
  724.         if (DIM2 = 0) or (DIM2 = maxnet-1) then
  725.            offsetv := 0;
  726.            for zaehlerfort1 := 1 to vfakty do
  727.                index := offsetv + untereGr -1;
  728.                if (DIM2 = 0) then
  729.                   indexh := index - 1;
  730.                end;
  731.                if (DIM2 = maxnet-1) then
  732.                   indexh := index + 1;
  733.                end;
  734.                for zaehlerfort := untereGr to obereGr do
  735.                  inc(index);
  736.                  inc(indexh);
  737.                  Rote_Blaue_Teilchen[index] := 
  738.                       BitwiseUnd(Rote_Blaue_Teilchen[index],ausblenden,14);
  739.                  Rote_Blaue_Teilchen[index] :=  Rote_Blaue_Teilchen[index] + hilfrotblau[indexh];
  740.  
  741.                end; (* for zaehlerfort *)
  742.                offsetv := offsetv + vfaktx;
  743.            end; (* for zaehlerfort1 *) 
  744.  
  745.            if (DIM2 = 0) then
  746.               index := 1;
  747.               indexh:= vfaktx;
  748.            end;
  749.            if (DIM2 = maxnet-1) then
  750.                index  := vfaktx;
  751.                indexh := 1;
  752.            end;
  753.            for zaehlerfort := 1 to vfakty  do
  754.                Rote_Blaue_Teilchen[index] := 
  755.                       BitwiseUnd(Rote_Blaue_Teilchen[index],ausblenden,14);
  756.                Rote_Blaue_Teilchen[index] :=  
  757.                       Rote_Blaue_Teilchen[index] + hilfrotblau[indexh];
  758.                index := index+vfaktx;
  759.                indexh:= indexh+vfaktx;
  760.            end; (* for *)
  761.         end; (* if *)  
  762.  
  763.  
  764.  
  765.         offsetv := 0;
  766.         (* unterer Rand r2b2 und r3b3 *)
  767.         if (DIM1 = 0) then
  768.                 ausblenden := ausulru;
  769.                 besetzt := 60;
  770.         end; (* if *)
  771.  
  772.         (* oberer Rand r5b5 und r6b6 *)
  773.         if (DIM1 = maxnet-1) then 
  774.                 ausblenden := ausoru;
  775.                 besetzt := 3840;
  776.          end;(* if *)
  777.  
  778.         if (DIM1 = maxnet-1) or (DIM1 = 0) then  
  779.            for zaehlerfort1 := 1 to vfakty do
  780.                index := offsetv;
  781.                for zaehlerfort := 1 to vfaktx do
  782.                  inc(index);
  783.                  hilfrotblau[index] := bitwiseund(Rote_Blaue_Teilchen[index],besetzt,14);
  784.                end;
  785.                offsetv:=offsetv + vfaktx;
  786.            end; (* for *)
  787.            if (DIM1 = 0) then
  788.               offsetv := 0;
  789.            end;
  790.            if (DIM1 = maxnet-1) then
  791.               offsetv := vfaktx; 
  792.            end;
  793.            for zaehlerfort1 := 1 to vfakty-1 do
  794.                index:= offsetv;
  795.                if (DIM1 = 0) then
  796.                   indexh := index + vfaktx;
  797.                end;
  798.                if (DIM1 = maxnet-1) then
  799.                   indexh := index - vfaktx; 
  800.                end;
  801.                for zaehlerfort := 1 to vfaktx do
  802.                  inc(index);
  803.                  inc(indexh);
  804.                  Rote_Blaue_Teilchen[index] := 
  805.                             BitwiseUnd(Rote_Blaue_Teilchen[index],ausblenden,14);
  806.                  Rote_Blaue_Teilchen[index] :=  
  807.                             Rote_Blaue_Teilchen[index] +hilfrotblau[indexh];
  808.                end;
  809.                offsetv := offsetv + vfaktx;
  810.            end; (* for *)
  811.  
  812.            if (DIM1 = 0) then
  813.               index := vfaktx*(vfakty-1);
  814.               indexh := 0;
  815.            end;
  816.            if (DIM1 = maxnet-1) then
  817.               index := 0;
  818.               indexh := vfaktx*(vfakty-1);
  819.            end;
  820.            for zaehlerfort := 1 to vfakty do
  821.                inc(index);
  822.                inc(indexh);
  823.                Rote_Blaue_Teilchen[index] := 
  824.                             BitwiseUnd(Rote_Blaue_Teilchen[index],ausblenden,14);
  825.                Rote_Blaue_Teilchen[index] := 
  826.                           Rote_Blaue_Teilchen[index] + hilfrotblau[indexh];
  827.            end;(* for *)
  828.          end; (* if *)   (* ok *)                   
  829.  
  830.  
  831.     end; (* if *) 
  832.        
  833.  
  834.      
  835.  endparallel;
  836.  
  837.  
  838.  
  839. end fortbewegung;
  840.  
  841.  
  842.  
  843.  
  844. (***************************************************************************)
  845. (***                                                                     ***)
  846. (***     Prozedur Farbfeld                                               ***)
  847. (***              implements the local colour-field                      ***)
  848. (***                                                                     ***)
  849. (***************************************************************************)
  850.  
  851.  
  852.  
  853.  
  854.  
  855. procedure Farbfeld(vector zaehlerff : cardinal) : vector cardinal;
  856.  
  857.  
  858.  vector uebergabeteilchenrot,         uebergabeteilchenblau,
  859.         durchlauf,                    shiftcardinal,
  860.         shifthilf,                    phicardinal,
  861.         zaehler0,         zaehler1,        zaehler2,
  862.         zaehler3,         zaehler4,        zaehler5,
  863.         zaehler6,         zaehler7,        zaehler8,
  864.         zaehler9,         zaehler10,       zaehler11,
  865.         hilfcardinal,     farbfeld               :cardinal;
  866.         phi,              farbfeldxreal,   farbfeldyreal,
  867.         hilffloat                                :real;
  868.         farbfeldx,        farbfeldy              :integer;
  869.         
  870.  
  871.  
  872.  
  873.          (*****************************************************************)
  874.          (***                                                           ***)
  875.          (***     Unter - Prozedur Farbfeldzuweisen                     ***)
  876.          (***              angle phi ( von 0-360 )                      ***)
  877.          (***              will be set a value from 0 - 35              ***)
  878.          (***                                                           ***)
  879.          (*****************************************************************)
  880.  
  881.          procedure farbfeldzuweisen(vector phi : cardinal) : vector cardinal; 
  882.  
  883.            vector hilf1,hilf2 : cardinal;          
  884.  
  885.            begin
  886.  
  887.               hilf1 := phi mod 10;
  888.               hilf2 := phi div 10;
  889.               if hilf1>6 then inc(hilf2);end;
  890.               if hilf2 = 36 then hilf2 := 0;end;
  891.  
  892.             return(hilf2);
  893.            end farbfeldzuweisen;             
  894.  
  895.  
  896.  
  897.  
  898.  
  899.   begin
  900.  
  901.  
  902.         zaehler0 := 0;
  903.         zaehler1 := 0;
  904.         zaehler2 := 0;
  905.         zaehler3 := 0;
  906.         zaehler4 := 0;
  907.         zaehler5 := 0;
  908.         zaehler6 := 0;
  909.         zaehler7 := 0;
  910.         zaehler8 := 0;
  911.         zaehler9 := 0;
  912.         zaehler10 := 0;
  913.         zaehler11 := 0;
  914.         farbfeldx := 0;
  915.         farbfeldy := 0;
  916.  
  917.  
  918.         uebergabeteilchenrot := anzahlrotblau[zaehlerff];
  919.  
  920.          for durchlauf := 1 to 6 do
  921.  
  922.            case durchlauf of
  923.                  1 : propagate.rechts(uebergabeteilchenrot,zaehler6);|
  924.                  2 : propagate.links(uebergabeteilchenrot,zaehler0);|
  925.                  3 : propagate.oben_links(uebergabeteilchenrot,zaehler10);|
  926.                  4 : propagate.unten_links(uebergabeteilchenrot,zaehler2);|
  927.                  5 : propagate.oben_rechts(uebergabeteilchenrot,zaehler8);|
  928.                  6 : propagate.unten_rechts(uebergabeteilchenrot,zaehler4);
  929.            end;
  930.  
  931.          end; (* for *)
  932.  
  933.  
  934.         (* dekodieren *)
  935.  
  936.         hilfcardinal := zaehler0;
  937.         zaehler0 := hilfcardinal div offset6;
  938.         zaehler1 := hilfcardinal - zaehler0 * offset6;
  939.  
  940.         hilfcardinal := zaehler2;
  941.         zaehler2 := hilfcardinal div offset6;
  942.         zaehler3 := hilfcardinal - zaehler2 * offset6;
  943.  
  944.         hilfcardinal := zaehler4;
  945.         zaehler4 := hilfcardinal div offset6;
  946.         zaehler5 := hilfcardinal - zaehler4 * offset6;
  947.  
  948.         hilfcardinal := zaehler6;
  949.         zaehler6 := hilfcardinal div offset6;
  950.         zaehler7 := hilfcardinal - zaehler6 * offset6;
  951.  
  952.         hilfcardinal := zaehler8;
  953.         zaehler8 := hilfcardinal div offset6;
  954.         zaehler9 := hilfcardinal - zaehler8 * offset6;
  955.   
  956.         hilfcardinal := zaehler10;
  957.         zaehler10 := hilfcardinal div offset6;
  958.         zaehler11 := hilfcardinal - zaehler10 * offset6;
  959.  
  960.  
  961.  
  962.         farbfeldx := zaehler0 + zaehler0 + zaehler2 - zaehler4 - zaehler6 - zaehler6 - 
  963.                       zaehler8 + zaehler10;
  964.         farbfeldy := zaehler2 + zaehler2 + zaehler4 + zaehler4 - 
  965.                       zaehler8 - zaehler8 - zaehler10 - zaehler10;
  966.  
  967.         
  968.         farbfeldx := farbfeldx - zaehler1 - zaehler1 - zaehler3 + zaehler5 + 
  969.                       zaehler7 + zaehler7 + zaehler9 - zaehler11;
  970.  
  971.         farbfeldy := farbfeldy - zaehler3 - zaehler3 - zaehler5 - zaehler5 + 
  972.                       zaehler9 + zaehler9 + zaehler11 + zaehler11;
  973.  
  974.         
  975.         farbfeldxreal := float(farbfeldx) * 0.5;
  976.         farbfeldyreal := float(farbfeldy) * wurzel3durch4;
  977.  
  978.  
  979.         phi := 0.0;
  980.         if (farbfeldxreal > 0.00001) or (farbfeldxreal < -0.00001) then
  981.           phi := arctan2(farbfeldyreal,farbfeldxreal);end;
  982.         phi := (phi / PI) * 180.0;
  983.         if (farbfeldxreal < 0.00001) and (farbfeldxreal > -0.00001) then
  984.            if farbfeldyreal>0. then phi := 90. else phi := 270.;end;
  985.         end; 
  986.         if phi< 0.0 then phi := phi + 360.0; end;
  987.  
  988.  
  989.         phicardinal := trunc(phi);
  990.  
  991.     
  992.         farbfeld := farbfeldzuweisen(phicardinal);
  993.         return(farbfeld);
  994.  
  995.    
  996. end Farbfeld;
  997.         
  998.  
  999.  
  1000.  
  1001.  
  1002.  
  1003.  
  1004.  
  1005. (****************************************************************************)
  1006. (***                                                                      ***)
  1007. (***      Funktion Impulsberechnung:                                      ***)
  1008. (***              implements the velocity for each node                   ***)
  1009. (***                                                                      ***)
  1010. (****************************************************************************)
  1011.  
  1012.  
  1013.  
  1014. procedure Impulsberechnung (vector zaehler : cardinal) : Vector impulstyp;
  1015.  
  1016.  
  1017.   vector impuls_x,           impuls_y        : integer;
  1018.          hilf                                : impulstyp;
  1019.          impulshilfe,        impulshilfehalb : cardinal;
  1020.  
  1021.  
  1022.  
  1023.   begin
  1024.  
  1025.  
  1026.      
  1027.          impuls_x := 0;
  1028.          impuls_y := 0;
  1029.          impulshilfe := Rote_Blaue_Teilchen[zaehler];
  1030.          impulshilfehalb := impulshilfe div 2; 
  1031.     
  1032.          if odd(impulshilfe) 
  1033.                or odd(impulshilfehalb) then
  1034.                 impuls_x := impuls_x + 2;
  1035.                end;    (* r1 besetzt  *)
  1036.  
  1037.          impulshilfe := impulshilfehalb div 2;
  1038.          impulshilfehalb := impulshilfe div 2;
  1039.          
  1040.           
  1041.          if odd(impulshilfe) 
  1042.                or odd(impulshilfehalb) then
  1043.                 impuls_x := impuls_x + 1;
  1044.                 impuls_y := impuls_y + 1;
  1045.                end;    (* r2 besetzt  *)
  1046.  
  1047.          impulshilfe := impulshilfehalb div 2;
  1048.          impulshilfehalb := impulshilfe div 2;
  1049.  
  1050.          if odd(impulshilfe)
  1051.                or odd(impulshilfehalb) then
  1052.                 impuls_x := impuls_x - 1;
  1053.                 impuls_y := impuls_y + 1;
  1054.                end;    (* r3 besetzt  *)
  1055.  
  1056.          impulshilfe := impulshilfehalb div 2;
  1057.          impulshilfehalb := impulshilfe div 2;
  1058.  
  1059.          if odd(impulshilfe)
  1060.                or odd(impulshilfehalb) then
  1061.                 impuls_x := impuls_x - 2;
  1062.                end;    (* r4 besetzt  *)
  1063.          
  1064.          impulshilfe := impulshilfehalb div 2;
  1065.          impulshilfehalb := impulshilfe div 2;
  1066.  
  1067.          if odd(impulshilfe)
  1068.                or odd(impulshilfehalb) then
  1069.                 impuls_x := impuls_x - 1;
  1070.                 impuls_y := impuls_y - 1;
  1071.                end;    (* r5 besetzt  *)
  1072.  
  1073.          impulshilfe := impulshilfehalb div 2;
  1074.          impulshilfehalb := impulshilfe div 2;
  1075.    
  1076.          if odd(impulshilfe) 
  1077.                or odd(impulshilfehalb) then
  1078.                 impuls_x := impuls_x + 1;
  1079.                 impuls_y := impuls_y - 1;
  1080.                end;    (* r6 besetzt  *)
  1081.  
  1082.          hilf.impuls_x := impuls_x;
  1083.          hilf.impuls_y := impuls_y;
  1084.  
  1085.          return(hilf);
  1086.  
  1087.  
  1088.  end Impulsberechnung;
  1089.  
  1090.  
  1091.  
  1092.  
  1093.  
  1094. (****************************************************************************)
  1095. (***                                                                      ***)
  1096. (***      Funktion AnzahlroteTeilchen                                     ***)
  1097. (***              implements the number of red particels for each node    ***)
  1098. (***                                                                      ***)
  1099. (****************************************************************************)
  1100.  
  1101.  
  1102. procedure AnzahlroteTeilchen (vector zaehlerr : cardinal) : vector cardinal;
  1103.  
  1104.   vector shiftcard,
  1105.          zaehlerrot1,    
  1106.          zaehlerrot2 : cardinal;
  1107.  
  1108.  
  1109.  
  1110.   begin
  1111.    
  1112.        shiftcard := Rote_Blaue_Teilchen[zaehlerr] div 2;
  1113.        zaehlerrot1 := 0;       
  1114.  
  1115.        for zaehlerrot2 := 0 to 7 do
  1116.             if odd(shiftcard) then
  1117.                 inc(zaehlerrot1);
  1118.             end;
  1119.             shiftcard := shiftcard div 4;
  1120.        end;
  1121.       
  1122.        return(zaehlerrot1);
  1123.  
  1124.   end AnzahlroteTeilchen;
  1125.  
  1126.  
  1127.  
  1128.  
  1129.  
  1130.  
  1131. (****************************************************************************)
  1132. (***                                                                      ***)
  1133. (***      Funktion AnzahlblaueTeilchen                                    ***)
  1134. (***              implements the number of blue particels for each node   ***)
  1135. (***                                                                      ***)
  1136. (****************************************************************************)
  1137.  
  1138.  
  1139. procedure AnzahlblaueTeilchen (vector zaehlerb : cardinal) : vector cardinal;
  1140.  
  1141.   vector shiftcard,         zaehlerblau1,            zaehlerblau2 : cardinal;
  1142.  
  1143.  
  1144.  
  1145.   begin
  1146.    
  1147.        shiftcard := Rote_Blaue_Teilchen[zaehlerb];
  1148.        zaehlerblau1 := 0;       
  1149.  
  1150.        for zaehlerblau2 := 0 to 7 do
  1151.             if odd(shiftcard) then
  1152.                 inc(zaehlerblau1);
  1153.             end;
  1154.             shiftcard := shiftcard div 4;
  1155.        end;
  1156.       
  1157.        return(zaehlerblau1);
  1158.  
  1159.   end AnzahlblaueTeilchen;
  1160.  
  1161.  
  1162.  
  1163.  
  1164.  
  1165.  
  1166. (****************************************************************************)
  1167. (***                                                                      ***)
  1168. (***      Prozedur RotateFarbfeld                                         ***)
  1169. (***              rotate the colour field in an area from 0-4             ***)
  1170. (***                                                                      ***)
  1171. (****************************************************************************)
  1172.  
  1173.  
  1174.  
  1175. procedure Rotatefarbfeld (vector var farbfeldalt,farbfeldneu,zaehlerrot : cardinal);
  1176.  
  1177.  
  1178.         (********************************************************************)
  1179.         (***                                                              ***)
  1180.         (***      Hilfsprozedur trans                                     ***)
  1181.         (***              transforms each cell to a new state             ***)
  1182.         (***                                                              ***)
  1183.         (********************************************************************)
  1184.         procedure trans(); 
  1185.  
  1186.             const r0b0ueber = 4096;                          r0b0aus   = 4095;
  1187.                   b1ueber   = 1024;                          r1ueber   = 2048;
  1188.                   r0b0orig  = 12288;                         b0ueber   = 4096;
  1189.                   r0ueber   = 8192;                          zweihoch12= 2**12;
  1190.                     
  1191.             vector uebergabeteilchen,        hilf               :cardinal;
  1192.  
  1193.              begin
  1194.                (* Prinzip : r0,b0 bleibt erhalten;    *)
  1195.                (* r6 - b2 werden nach rechts geshiftet *)
  1196.                (* r1,b1 wird zu r6,b6                 *)
  1197.                uebergabeteilchen := Rote_Blaue_Teilchen[zaehlerrot];
  1198.                hilf := Rote_Blaue_Teilchen[zaehlerrot] div zweihoch12;
  1199.                hilf := hilf * zweihoch12;
  1200.                (* r0,b0 ausblenden     *)
  1201.                uebergabeteilchen := uebergabeteilchen - hilf;
  1202.                (* 2 nach rechts shiften *)
  1203.                uebergabeteilchen := uebergabeteilchen div 4;
  1204.                (* war r1 oder b1 gesetzt ?  *)
  1205.                if odd(Rote_Blaue_Teilchen[zaehlerrot]) then 
  1206.                                                        uebergabeteilchen:=uebergabeteilchen+b1ueber;
  1207.                else
  1208.                   if odd(Rote_Blaue_Teilchen[zaehlerrot] div 2) then 
  1209.                                  uebergabeteilchen:=uebergabeteilchen+r1ueber;end;
  1210.                end;
  1211.                (* war r0 oder b0 gesetzt ?  *)
  1212.                if hilf = b0ueber then 
  1213.                               uebergabeteilchen:=uebergabeteilchen+b0ueber;
  1214.                else
  1215.                    if hilf = r0ueber then 
  1216.                               uebergabeteilchen:=uebergabeteilchen+r0ueber;end;
  1217.                end;
  1218.                Rote_Blaue_Teilchen[zaehlerrot] := uebergabeteilchen; 
  1219.               end trans;
  1220.  
  1221.    begin
  1222.     
  1223.      farbfeldneu := farbfeldalt;
  1224.      while(farbfeldneu>5) do
  1225.         farbfeldneu := farbfeldneu - 6;
  1226.         trans;
  1227.      end;
  1228.  
  1229.    end Rotatefarbfeld;
  1230.  
  1231.  
  1232.  
  1233.  
  1234.  
  1235.  
  1236.  
  1237.  
  1238. (****************************************************************************)
  1239. (***                                                                      ***)
  1240. (***      Prozedur ReRotateFarbfeld                                       ***)
  1241. (***              rerotate colour field in the area 0-4                   ***)
  1242. (***                                                                      ***)
  1243. (****************************************************************************)
  1244.  
  1245.  
  1246.  
  1247. procedure ReRotatefarbfeld (vector var farbfeldalt,farbfeldneu,zaehlerrerot : cardinal);
  1248.  
  1249.  
  1250.         (********************************************************************)
  1251.         (***                                                              ***)
  1252.         (***      Hilfsprozedur retrans                                   ***)
  1253.         (***              transforms each cell back to its old state      ***)
  1254.         (***                                                              ***)
  1255.         (********************************************************************)
  1256.         procedure retrans(); 
  1257.  
  1258.             const r0b0ueber     = 4096;                 r0b0r6b6aus   = 1023;
  1259.                   b1ueber       = 1024;                 r1ueber       = 2048;
  1260.                   r0b0orig      = 12288;                b0ueber       = 4096;
  1261.                   r0ueber       = 8192;                 zweihoch10    = 2**10;
  1262.                   
  1263.     
  1264.             vector uebergabeteilchen,    hilf1,    hilf        :cardinal;
  1265.  
  1266.  
  1267.             begin
  1268.                (* Prinzip : r0,b0 bleibt erhalten;     *)
  1269.                (* r6 - b2 werden nach links geshiftet *)
  1270.                (* r6,b6 wird zu r1,b1                  *)
  1271.                uebergabeteilchen := Rote_Blaue_Teilchen[zaehlerrerot];
  1272.                (* r0,b0,r6,b6 ausblenden     *)
  1273.                hilf := uebergabeteilchen div zweihoch10;
  1274.                hilf1 := hilf * zweihoch10;
  1275.                uebergabeteilchen := uebergabeteilchen - hilf1;
  1276.                (* 2 nach rechts shiften *)
  1277.                uebergabeteilchen := uebergabeteilchen * 4;
  1278.                (* war r6 oder b6 gesetzt ?  *)
  1279.                (* b6 gesetzt *)
  1280.                if odd(hilf) then uebergabeteilchen:=uebergabeteilchen+1;end;
  1281.                (* r6 gesetzt *)
  1282.                hilf := hilf div 2; 
  1283.                if odd(hilf) then uebergabeteilchen:=uebergabeteilchen+2;end;
  1284.                (* war r0 oder b0 gesetzt ?  *)
  1285.                hilf := hilf div 2;
  1286.                (* b0 gesetzt *)
  1287.                if odd(hilf) then uebergabeteilchen:=uebergabeteilchen+b0ueber;end;
  1288.                (* r0 gesetzt *)
  1289.                hilf := hilf div 2;
  1290.                if odd(hilf) then uebergabeteilchen:=uebergabeteilchen+r0ueber;end;
  1291.                Rote_Blaue_Teilchen[zaehlerrerot] := uebergabeteilchen; 
  1292.               end retrans;
  1293.  
  1294.    begin
  1295.     
  1296.      while(farbfeldneu<>farbfeldalt) do
  1297.         farbfeldneu := farbfeldneu + 6;
  1298.         retrans;
  1299.      end;
  1300.  
  1301.    end ReRotatefarbfeld;
  1302.  
  1303.  
  1304.  
  1305.  
  1306.  
  1307.  
  1308.  
  1309. (****************************************************************************)
  1310. (***                                                                      ***)
  1311. (***      Prozedur Impulstabelleeinlesen                                  ***)
  1312. (***              loads the table for velocity                            ***)
  1313. (***                                                                      ***)
  1314. (****************************************************************************)
  1315.  
  1316.  
  1317.  
  1318. procedure Impulstabeinlesen();
  1319.  
  1320.  scalar impulsfeld : impulsfeldtyp;
  1321.         fileint1,         fileint2,             fileint3,
  1322.         zaehler1,         zaehler2        : integer;
  1323.  
  1324.   begin
  1325.  
  1326.    
  1327.     (* Initialisieren *)
  1328.     for zaehler1:=-4 to 4 do
  1329.         for zaehler2:=-2 to 2 do
  1330.              impulsfeld[zaehler1][zaehler2] :=0 ;
  1331.         end;
  1332.     end;
  1333.  
  1334.     openinput(Impulstabelle);
  1335.      if not(DONE) then errorhandle(2);end;
  1336.     
  1337.     for zaehler1:=1 to 19 do
  1338.        readint(fileint1);
  1339.        readint(fileint2);
  1340.        readint(fileint3);
  1341.        impulsfeld[fileint1][fileint2] := fileint3;
  1342.     end;
  1343.     
  1344.     closeinput;
  1345.  
  1346.  
  1347.     parallel
  1348.        for zaehler1:=-4 to 4 do
  1349.            for zaehler2:=-2 to 2 do
  1350.                    impulsfeldall[zaehler1][zaehler2] := impulsfeld[zaehler1][zaehler2] ;
  1351.             end;
  1352.        end;
  1353.     endparallel;
  1354.  
  1355.      
  1356.  
  1357.   end Impulstabeinlesen;
  1358.     
  1359.  
  1360.  
  1361.  
  1362.  
  1363. (****************************************************************************)
  1364. (***                                                                      ***)
  1365. (***      Prozedur Teilchentabelleeinlesen                                ***)
  1366. (***              loads the table for the particels                       ***)
  1367. (***                                                                      ***)
  1368. (****************************************************************************)
  1369.  
  1370.  
  1371.  
  1372. procedure Teilcheneinlesen();
  1373.  
  1374.  scalar teilchenfeld : teilchenfeldtyp;
  1375.                      (* rote T. , Blaue T. , Nummer *)
  1376.         fileint1,        fileint2,      fileint3,
  1377.         zaehler1,        zaehler2               : integer;
  1378.  
  1379.   begin
  1380.  
  1381.  
  1382.     (* Initialisieren *)
  1383.     for zaehler1:=0 to 7 do
  1384.         for zaehler2:=0 to 7 do
  1385.              teilchenfeld[zaehler1][zaehler2] :=0 ;
  1386.         end;
  1387.     end;
  1388.  
  1389.     openinput(Teilchentabelle);
  1390.       if not(DONE) then errorhandle(2);end;
  1391.  
  1392.     for zaehler1:=1 to 36 do
  1393.        readint(fileint1);
  1394.        readint(fileint2);
  1395.        readint(fileint3);
  1396.        teilchenfeld[fileint1][fileint2] := fileint3;
  1397.     end;    
  1398.     
  1399.     closeinput;
  1400.  
  1401.     parallel
  1402.       for zaehler1:=0 to 7 do
  1403.         for zaehler2:=0 to 7 do
  1404.              teilchenfeldall[zaehler1][zaehler2] := teilchenfeld[zaehler1][zaehler2] ;
  1405.         end;
  1406.       end;
  1407.     endparallel;
  1408.  
  1409.  
  1410.  
  1411.   end Teilcheneinlesen;
  1412.  
  1413.  
  1414.  
  1415.  
  1416. (****************************************************************************)
  1417. (***                                                                      ***)
  1418. (***      Prozedur Zuordungstabellelesen                                  ***)
  1419. (***              loads the table for getting a state                     ***)
  1420. (***                                                                      ***)
  1421. (****************************************************************************)
  1422.   
  1423.  
  1424.  
  1425. procedure Zuordeinlesen();
  1426.  
  1427.  scalar teilimpfeld : teilimptyp;
  1428.                      (* Teilchen , Impuls , Nummer *)
  1429.         fileint1,        fileint2,         fileint3,
  1430.         zaehler1,        zaehler2,         zaehler3        : cardinal;
  1431.         sizei: integer;
  1432.  
  1433.   begin
  1434.  
  1435.  
  1436.  
  1437.     (* Initialisieren *)
  1438.     for zaehler1:=1 to 19 do
  1439.         for zaehler2:=1 to 36 do
  1440.              teilimpfeld[zaehler1][zaehler2] :=0 ;
  1441.         end;
  1442.     end;
  1443.  
  1444.     openinput(Zuordtabelle);
  1445.      if not(DONE) then errorhandle(2);end;
  1446.  
  1447.     for zaehler3 := 1 to 360 do                       
  1448.        readcard(fileint1);
  1449.        readcard(fileint2);
  1450.        readcard(fileint3);
  1451.        teilimpfeld[fileint1][fileint2] := fileint3;
  1452.     end;    
  1453.     
  1454.     closeinput;
  1455.  
  1456.     parallel
  1457.       for zaehler1:= 1 to 19 do
  1458.           for zaehler2 := 1 to 36 do
  1459.                  teilimpfeldall[zaehler1][zaehler2] := teilimpfeld[zaehler1][zaehler2];
  1460.           end;
  1461.       end;
  1462.     endparallel;
  1463.  
  1464.  
  1465.   end Zuordeinlesen;
  1466.  
  1467.  
  1468.  
  1469.  
  1470.  
  1471. (****************************************************************************)
  1472. (***                                                                      ***)
  1473. (***      Prozedur Schnappschuss                                          ***)
  1474. (***          snapshots the current state in a specified file             ***)
  1475. (***                                                                      ***)
  1476. (****************************************************************************)
  1477.  
  1478.  
  1479.  
  1480. procedure schnappschuss(scalar string : string80);
  1481.  
  1482.    vector    zaehler1,      zaehler2,
  1483.              offsetv                : cardinal;
  1484.  
  1485.   begin
  1486.     
  1487.        openoutput(filestring);
  1488.          if not(DONE) then errorhandle(1);end;
  1489.          parallel
  1490.            offsetv := 0;
  1491.            for zaehler1 := 1 to vfakty do
  1492.                for zaehler2 := 1 to vfaktx do
  1493.                    writecard(Rote_Blaue_Teilchen[zaehler2+offsetv],6);
  1494.                end;
  1495.              offsetv := offsetv + vfaktx;
  1496.            end;
  1497.          endparallel;    
  1498.        closeoutput;
  1499.  
  1500.   end schnappschuss;
  1501.  
  1502.  
  1503.  
  1504.  
  1505. (****************************************************************************)
  1506. (***                                                                      ***)
  1507. (***      Prozedur Schnappschussgeord                                     ***)
  1508. (***          another way to snapshot for each stae in descending order   ***)
  1509. (***          much slower than the other way above                        ***)
  1510. (***                                                                      ***)
  1511. (****************************************************************************)
  1512.  
  1513.  
  1514.  
  1515. procedure schnappschussgeord(scalar string : string80);
  1516.  
  1517.    vector    zaehler1,      zaehler2,             zaehler3,
  1518.              offsetv                                       : cardinal;
  1519.  
  1520.   begin
  1521.     
  1522.        openoutput(filestring);
  1523.          if not(DONE) then errorhandle(1);end;
  1524.          parallel
  1525.            offsetv := 0;
  1526.            for zaehler1 := 1 to vfakty do
  1527.               for zaehler3 := 0 to maxnet-1 do
  1528.                   for zaehler2 := 1 to vfaktx do
  1529.                       if ((maxnet-1)-DIM1)= zaehler3 then
  1530.                         writecard(Rote_Blaue_Teilchen[zaehler2+offsetv],6);
  1531.                       end;
  1532.                   end;
  1533.               end;
  1534.               offsetv := offsetv + vfaktx;
  1535.            end;
  1536.          endparallel;    
  1537.        closeoutput;
  1538.  
  1539.   end schnappschussgeord;
  1540.         
  1541.  
  1542.  
  1543.  
  1544. (****************************************************************************)
  1545. (***                                                                      ***)
  1546. (***      Prozedur Aufsetzer_einlesen                                     ***)
  1547. (***               loads a snapshot                                       ***)
  1548. (***                                                                      ***)
  1549. (****************************************************************************)
  1550.  
  1551.  
  1552. procedure aufsetzer_einlesen();
  1553.  
  1554.   scalar zaehlera,zaehlerb,zaehlerc,teils (**) : cardinal;
  1555.          wodatei : string80;
  1556.          getan : boolean;
  1557.          feld : array[0..127],[0..127] of cardinal;
  1558.   vector teil :cardinal;
  1559.  
  1560.  
  1561.   begin
  1562.  
  1563.  
  1564.     openinput(aufsetzerfile);
  1565.       if not(DONE) then errorhandle(2);end;
  1566.       readstring(wodatei);
  1567.     closeinput;
  1568.  
  1569.     openinput(wodatei);
  1570.       if not(DONE) then errorhandle(2);end;
  1571.       writestring(wodatei);
  1572.       writeln;
  1573.  
  1574. (*     parallel
  1575.  
  1576.       zaehlera := 1;
  1577.       getan := true;
  1578.       while getan do
  1579.  
  1580. writecard(zaehlera,5);
  1581.             ReadCard(teil);
  1582.             getan := DONE;
  1583.             Rote_Blaue_Teilchen[zaehlera] := teil;
  1584.             inc(zaehlera);
  1585.       end;
  1586.      endparallel;
  1587. writeln;*)
  1588.  
  1589.      for zaehlerc := 1 to 4 do
  1590. writecard(zaehlerc,5);
  1591. writeln;
  1592.        for zaehlera := 0 to 127 do
  1593.          for zaehlerb := 0 to 127 do
  1594.              Readcard(teils);
  1595.              feld[zaehlera][zaehlerb] := teils;
  1596.          end;
  1597.        end;
  1598.        parallel
  1599.          load(Rote_Blaue_Teilchen[zaehlerc],feld);
  1600.        endparallel;
  1601.      end;
  1602.  
  1603.  
  1604.  
  1605.  
  1606.  
  1607.  
  1608.     closeinput;
  1609.  
  1610. end aufsetzer_einlesen;
  1611.  
  1612.  
  1613.  
  1614.          
  1615. (****************************************************************************)
  1616. (***                                                                      ***)
  1617. (***      Prozedur Aufsetzer_einlesengeordnet                             ***)
  1618. (***               loads a snapshot in descending order (see above)       ***)
  1619. (***                                                                      ***)
  1620. (****************************************************************************)
  1621.  
  1622.  
  1623. procedure aufsetzer_einlesen_geordnet();
  1624.  
  1625.   scalar zaehler1,       zaehler2,       virtpesx,
  1626.          virtpesy                        : cardinal;
  1627.  
  1628.   begin
  1629.     
  1630.  
  1631.     openinput(aufsetzerfile);
  1632.       if not(DONE) then errorhandle(2);end;
  1633.  
  1634.     readcard(virtpesx);
  1635.     readcard(virtpesy);
  1636.  
  1637.     parallel
  1638.         for zaehler1 := 1 to virtpesy div maxnet do
  1639.             for zaehler2 := 1 to virtpesx div maxnet do
  1640.                 readcard(Rote_Blaue_Teilchen[zaehler1+(zaehler2-1)*(virtpesx div maxnet)]);
  1641.             end;
  1642.         end;
  1643.       
  1644.     endparallel;
  1645.     closeinput;
  1646.  
  1647. end aufsetzer_einlesen_geordnet;
  1648.  
  1649.  
  1650.  
  1651.  
  1652. (****************************************************************************)
  1653. (***                                                                      ***)
  1654. (***      Prozedur ausgabe_rot_blau                                       ***)
  1655. (***          produces SUN-Rasterfiles with one colour for each state     ***)
  1656. (***                                                                      ***)
  1657. (****************************************************************************)
  1658.  
  1659.  
  1660.  
  1661. procedure ausgabe_rot_blau(scalar string : string80);
  1662.  
  1663.  
  1664.    scalar filehilf1,        filehilf2,
  1665.           filehilf3                    : cardinal;
  1666.  
  1667.          
  1668.    vector rotblau,
  1669.           hilfrotblau   : rotblauteilchentyp;
  1670.           durchlauf,     roteT,        blaueT,      hilfsvar,
  1671.           hilf1,         hilf2,        hilf3,
  1672.           hilf4,         maxhilf,      zeilenfaktor  : cardinal;
  1673.  
  1674.  
  1675.  
  1676.       procedure belegerotblau(vector teil,stelle1:cardinal);
  1677.  
  1678.  
  1679.          begin
  1680.               if teil=0 then rotblau[stelle1]:=0
  1681.                         else rotblau[stelle1]:=1; end;
  1682.          end belegerotblau;
  1683.  
  1684.  
  1685.  
  1686.  
  1687.  
  1688.  
  1689.   begin
  1690.  
  1691.        writestring('Datei :');
  1692.        writestring(filestring);
  1693.        writestring('   geschrieben');
  1694.        writeln;
  1695.        openoutput(filestring);
  1696.        if not(DONE) then errorhandle(1);end;
  1697.  
  1698.        write(chr(89));
  1699.        write(chr(166));
  1700.        write(chr(106));
  1701.        write(chr(149));
  1702.        
  1703.        write(chr(0));        (* Laenge *)
  1704.        write(chr(0));
  1705.          filehilf1 := virtuellepesy div 256;
  1706.        write(chr(filehilf1)); 
  1707.          filehilf2 := virtuellepesy - filehilf1 * 256;      
  1708.        write(chr(filehilf2));
  1709.        
  1710.        write(chr(0));        (* Breite *)
  1711.        write(chr(0));
  1712.          filehilf1 := virtuellepesx div 256;
  1713.        write(chr(filehilf1));
  1714.          filehilf2 := virtuellepesx - filehilf1 * 256;
  1715.        write(chr(filehilf2));
  1716.        
  1717.        write(chr(0));
  1718.        write(chr(0));
  1719.        write(chr(0));
  1720.        write(chr(1));
  1721.        write(chr(0));         (* Laenge * Breite *)
  1722.          filehilf1 := (virtuellepesx * virtuellepesy);(*vorher **2*)
  1723.          filehilf2 := filehilf1 div 256**2;
  1724.        write(chr(filehilf2));
  1725.          filehilf1 := filehilf1 - filehilf2  * 256**2;
  1726.          filehilf2 := filehilf1 div 256;
  1727.        write(chr(filehilf2));
  1728.          filehilf1 := filehilf1 - filehilf2  * 256;
  1729.        write(chr(filehilf1));
  1730.        
  1731.        write(chr(0));
  1732.        write(chr(0));
  1733.        write(chr(0));
  1734.        write(chr(1));
  1735.        
  1736.        write(chr(0));
  1737.        write(chr(0));
  1738.        write(chr(0));
  1739.        write(chr(0));
  1740.        
  1741.        write(chr(0));
  1742.        write(chr(0));
  1743.        write(chr(0));
  1744.        write(chr(0));
  1745.  
  1746.        parallel
  1747.           (* Initialisierung *)
  1748.           for hilf1 := 1 to vfakt do
  1749.                rotblau[hilf1] := 0;
  1750.                hilfrotblau[hilf1] := 0;
  1751.           end; (* for *)
  1752.  
  1753.  
  1754.           for hilf1 :=1 to vfakt do
  1755.                roteT  := anzahlrotblau[hilf1] div offset6;
  1756.                blaueT := anzahlrotblau[hilf1] - roteT * offset6;
  1757.                if roteT > blaueT  then belegerotblau(0,hilf1);
  1758.                                   else belegerotblau(1,hilf1); end; 
  1759.           end;  (* for *)
  1760.  
  1761.  
  1762.           for durchlauf := 0 to 6 do
  1763.               if dim2 mod 8 = durchlauf then
  1764.                                          for hilf1 := 1 to vfakt do
  1765.                                              rotblau[hilf1] := rotblau[hilf1] * 2;
  1766.                                          end;
  1767.               end;
  1768.               (*if (dim2 mod 8 = durchlauf) or (dim2 mod 8 = (durchlauf + 1)) then*)
  1769.                    for hilf1 := 1 to vfakt do 
  1770.                        propagate.rechts(rotblau[hilf1],hilfsvar);
  1771.                        hilfrotblau[hilf1] := hilfsvar;
  1772.                    end;
  1773.               (*end;*)
  1774.               if dim2 mod 8 = (durchlauf + 1) then 
  1775.                                           for hilf1 := 1 to vfakt do
  1776.                                                rotblau[hilf1] := rotblau[hilf1] + hilfrotblau[hilf1];
  1777.                                           end;
  1778.               end;
  1779.           end; (* for *)
  1780.  
  1781.  
  1782.          zeilenfaktor := 0;
  1783.          maxhilf := maxnet-1;
  1784.          for hilf1 := 1 to vfakty do 
  1785.               for hilf2 := 0 to maxhilf do
  1786.                   for hilf3 := 1 to vfaktx do
  1787.                       if ((maxhilf - DIM1) = hilf2) then
  1788.                          hilf4 := hilf3 + zeilenfaktor;
  1789.                          if (dim2 mod 8 = 7) then write(chr(rotblau[hilf4]));end;
  1790.                       end;(* if *)
  1791.                   end; (* for hilf3 *)
  1792.               end;  (* for hilf2 *)
  1793.               zeilenfaktor := zeilenfaktor + vfaktx;
  1794.          end;   (* for hilf1 *)
  1795.           
  1796.        endparallel; 
  1797.     
  1798.        closeoutput;
  1799.        if not(DONE) then errorhandle(3);end;
  1800.  
  1801.  
  1802.   end ausgabe_rot_blau;
  1803.  
  1804.  
  1805.  
  1806. (****************************************************************************)
  1807. (***                                                                      ***)
  1808. (***      Prozedur Kollisionstabelle                                      ***)
  1809. (***          loads the collision table                                   ***)
  1810. (***                                                                      ***)
  1811. (****************************************************************************)
  1812.  
  1813.  
  1814. procedure Koltabeinlesen();
  1815.  
  1816.  scalar kolfeld  : kolfeldtyp;
  1817.                      (* farbfeld , Zustandsnummer -> #Gleiche  ,Ausgangsposition   *)
  1818.                      (*                              Bit 1-4   ,Bit 5-16           *)
  1819.         fileint1,         fileint2,        fileint3,
  1820.         fileint4,         zaehler1,        zaehler2,
  1821.         durchlauf                                  : cardinal;
  1822.         kolfeldtemp                                : array[1..360] of cardinal;
  1823.  
  1824.  
  1825.   begin
  1826.  
  1827.  
  1828.     (* Initialisieren *)
  1829.     for zaehler1:=0 to 3 do
  1830.         for zaehler2:=1 to 180 do
  1831.              kolfeld[zaehler1][zaehler2] :=0 ;
  1832.         end;
  1833.     end;
  1834.     for zaehler2:=1 to 180 do
  1835.         kolfeldtemp[zaehler2] :=0 ;
  1836.     end;
  1837.  
  1838.  
  1839.  
  1840.     for durchlauf := 0 to 3 do
  1841.  
  1842.  
  1843.              case durchlauf  of
  1844.                      0 : openinput(Kollisionstabelle1);|
  1845.                      1 : openinput(Kollisionstabelle2);|
  1846.                      2 : openinput(Kollisionstabelle3);|
  1847.                      3 : openinput(Kollisionstabelle4);
  1848.              end;
  1849.     if not(DONE) then errorhandle(2);end;
  1850.  
  1851.     (* in der Tabelle Kolfeld werden die Anzahl gleicher Zustaende in  *)
  1852.     (* codierter Form gespeichert.                                     *)
  1853.     (* 'High-Bytes' : Position in der Kollisionstab                    *)
  1854.     (* 'Low-Bytes ' : #gleicher Zustaende                              *)
  1855.  
  1856.  
  1857.     
  1858.     for zaehler1:=1 to 360 do
  1859.        readint(fileint1);
  1860.        readint(fileint2);
  1861.        readint(fileint3);
  1862.        readint(fileint4);
  1863.  
  1864.        (* Da Farbfeld 2 identisch mit Farbfeld 1 ist, muss ab Ff. 3   *)
  1865.        (* eine Abbildung erfolgen, um nicht eine ganze Spalte der     *)
  1866.        (* Matrix freilassen zu muessen !                              *)
  1867.        (*   Abbildung :  Farbfeld 0 -> Nummer 0                       *)
  1868.        (*                Farbfeld 1 -> Nummer 1                       *)
  1869.        (*                Farbfeld 2 -> Nummer 1                       *)
  1870.        (*                Farbfeld 3 -> Nummer 2                       *)
  1871.        (*                Farbfeld 4 -> Nummer 3                       *)
  1872.        (*  Ff. 2 existiert dabei nicht als Datei !!                   *)
  1873.  
  1874.        if fileint1>2 then fileint1 := fileint1 - 1; end;
  1875.  
  1876.        (* High-Byte codieren *)
  1877.        fileint3 := fileint3 * offset4;
  1878.        fileint3 := fileint3 + fileint4;
  1879.  
  1880.        kolfeldtemp[fileint2] := fileint3;
  1881.   
  1882.     end;  (* for *)
  1883.  
  1884.  
  1885.     for zaehler1 := 1 to 180 do
  1886.         kolfeld[fileint1][zaehler1] := kolfeldtemp[zaehler1*2-1] * offset15 + kolfeldtemp[zaehler1*2];
  1887.     end;  
  1888.     
  1889.  
  1890.     closeinput;
  1891.     end; (* for *)
  1892.  
  1893.  
  1894.  
  1895.     parallel
  1896.       for zaehler1 := 0 to 3 do
  1897.            for zaehler2 := 1 to 180 do
  1898.                 kolfeldall[zaehler1][zaehler2] := kolfeld[zaehler1][zaehler2];
  1899.            end;
  1900.       end;
  1901.     endparallel;
  1902.  
  1903.  
  1904.  
  1905.   end Koltabeinlesen;
  1906.  
  1907.  
  1908.  
  1909.  
  1910.  
  1911.  
  1912.  
  1913.  
  1914. (****************************************************************************)
  1915. (***                                                                      ***)
  1916. (***      Prozedur Kollisionstabelle                                      ***)
  1917. (***          loads the collision table                                   ***)
  1918. (***                                                                      ***)
  1919. (****************************************************************************)
  1920.  
  1921.  
  1922. procedure kollisionstab();
  1923.  
  1924.  
  1925.  scalar zustandstab : zustandstyp;
  1926.                             (* 1788 Zustaende codiert *)
  1927.         temptab : array[0 .. (file1l+file2l+file3l+file4l)+1] of cardinal;
  1928.         filecard1,        position,          position2,
  1929.         filezaehler,      durchlauf,         hilf,
  1930.         maxpos,           schleifezaehler   : cardinal;
  1931.         vorsicht                            : boolean;
  1932.  
  1933.  
  1934.  
  1935.   begin
  1936.      
  1937.      (* Initialisierung *)
  1938.      vorsicht := false;
  1939.      maxpos := file1l+file2l+file3l+file4l;
  1940.      if odd(maxpos) then maxpos := (maxpos div 2)+1;
  1941.                     else maxpos := maxpos div 2; end;
  1942.      for position := 0 to maxpos do
  1943.          zustandstab[position] := 0;
  1944.      end; (* for *)
  1945.  
  1946.      for position := 0 to (file1l+file2l+file3l+file4l)+1 do
  1947.          temptab[position] := 0;
  1948.      end; (* for *)
  1949.  
  1950.      position :=0;
  1951.       
  1952.      for durchlauf := 0 to 3 do
  1953.     
  1954.              case durchlauf  of
  1955.                      0 : openinput(file1);
  1956.                          filezaehler:= file1l; | 
  1957.                      1 : openinput(file2);
  1958.                          filezaehler:= file2l; |
  1959.                      2 : openinput(file3);
  1960.                          filezaehler:= file3l; |
  1961.                      3 : openinput(file4);
  1962.                          filezaehler:= file4l; 
  1963.              end;
  1964.  
  1965.         if not(DONE) then errorhandle(2);end;
  1966.    
  1967.         for schleifezaehler := 1 to filezaehler do
  1968.               readcard(filecard1);
  1969.               temptab[position] := filecard1;
  1970.               inc(position);
  1971.         end;
  1972.         closeinput;
  1973.  
  1974.  
  1975.      end; (* for *)
  1976.  
  1977.  
  1978.      position := 0;
  1979.      position2:= 0;
  1980.  
  1981.      if odd(maxpos) then vorsicht :=true; end;
  1982.  
  1983.    
  1984.      while position2 < maxpos do
  1985.        
  1986.          zustandstab[position2] := (temptab[position] * offset15) + temptab[(position+1)];
  1987.          position := position + 2;
  1988.          inc(position2);
  1989.          if position= maxpos-1 then
  1990.                       if vorsicht then
  1991.                           zustandstab[position2]:=temptab[position]* offset15;
  1992.                           position:=position + 1;
  1993.                       end;
  1994.                    end;
  1995.                           
  1996.      end;
  1997.      
  1998.      parallel
  1999.        for schleifezaehler:=0 to 894 do
  2000.                zustandstaball[schleifezaehler] := zustandstab[schleifezaehler];
  2001.        end;
  2002.      endparallel;
  2003.  
  2004.  
  2005.  
  2006.   end kollisionstab;
  2007.  
  2008.  
  2009.  
  2010.  
  2011.  
  2012.  
  2013. (****************************************************************************)
  2014. (***                                                                      ***)
  2015. (***      Prozedur Einlesen:                                              ***)
  2016. (***          for loading all tables and sending it to each PE`s          ***)
  2017. (***                                                                      ***)
  2018. (****************************************************************************)
  2019.  
  2020.  
  2021. procedure einlesen();
  2022.  
  2023.  
  2024.  begin
  2025.    Impulstabeinlesen;
  2026.    Teilcheneinlesen;
  2027.    Zuordeinlesen;
  2028.    Koltabeinlesen;
  2029.    kollisionstab;
  2030.  end einlesen;
  2031.    
  2032.  
  2033.  
  2034.  
  2035.  
  2036.  
  2037.  
  2038.  
  2039. (****************************************************************************)
  2040. (***                                                                      ***)
  2041. (***      Prozedur Randbehandlung                                         ***)
  2042. (***          collision on the processwing elements on each side          ***)
  2043. (***                                                                      ***)
  2044. (****************************************************************************)
  2045.  
  2046.  
  2047.  
  2048. procedure Randbehandlung(scalar string:stringtyp; vector zaehler:integer);
  2049.  
  2050.   const zweihoch2 = 2**2;    zweihoch3 = 2**3;    zweihoch4 = 2**4;
  2051.         zweihoch5 = 2**5;    zweihoch6 = 2**6;    zweihoch7 = 2**7;
  2052.         zweihoch8 = 2**8;    zweihoch9 = 2**9;    zweihoch10= 2**10;
  2053.         zweihoch11= 2**11;
  2054.  
  2055.   vector hilf : cardinal;
  2056.          
  2057.  
  2058.  
  2059.   procedure drehen(vector zaehler, woher, wohin : cardinal);
  2060.  
  2061.     begin
  2062.       Rote_Blaue_Teilchen[zaehler] := Rote_Blaue_Teilchen[zaehler] - woher;
  2063.       Rote_Blaue_Teilchen[zaehler] := Rote_Blaue_Teilchen[zaehler] + wohin;
  2064.     end drehen;  
  2065.  
  2066.  
  2067.  
  2068.  
  2069.   begin
  2070.     
  2071.       if string='unten' then
  2072.        if randunten='free_slip' then
  2073.           hilf := Rote_Blaue_Teilchen[zaehler] div zweihoch8;
  2074.           if odd(hilf) then 
  2075.                          drehen(zaehler,zweihoch8,zweihoch4);
  2076.           end;
  2077.           hilf := hilf div 2;
  2078.           if odd(hilf) then 
  2079.                          drehen(zaehler,zweihoch9,zweihoch5);
  2080.           end;
  2081.           hilf:= hilf div 2;
  2082.           if odd(hilf) then
  2083.                          drehen(zaehler,zweihoch10,zweihoch2); 
  2084.           end;
  2085.           hilf:= hilf div 2;
  2086.           if odd(hilf) then 
  2087.                          drehen(zaehler,zweihoch11,zweihoch3);
  2088.           end;
  2089.       else if randunten='no_slip' then
  2090.           hilf := Rote_Blaue_Teilchen[zaehler] div zweihoch8;
  2091.           if odd(hilf) then
  2092.                          drehen(zaehler,zweihoch8,zweihoch2); 
  2093.           end;
  2094.           hilf := hilf div 2;
  2095.           if odd(hilf) then 
  2096.                          drehen(zaehler,zweihoch9,zweihoch3);
  2097.           end;
  2098.           hilf:= hilf div 2;
  2099.           if odd(hilf) then 
  2100.                          drehen(zaehler,zweihoch10,zweihoch4);
  2101.           end;
  2102.           hilf:= hilf div 2;
  2103.           if odd(hilf) then 
  2104.                          drehen(zaehler,zweihoch11,zweihoch5);
  2105.           end;
  2106.         end;
  2107.      end;
  2108.     end;
  2109.  
  2110.     if string='oben' then
  2111.        if randoben='free_slip' then
  2112.           hilf := Rote_Blaue_Teilchen[zaehler] div zweihoch2;
  2113.           if odd(hilf) then
  2114.                          drehen(zaehler,zweihoch2,zweihoch10); 
  2115.           end;
  2116.           hilf := hilf div 2;
  2117.           if odd(hilf) then 
  2118.                          drehen(zaehler,zweihoch3,zweihoch11);
  2119.           end;
  2120.           hilf:= hilf div 2;
  2121.           if odd(hilf) then 
  2122.                          drehen(zaehler,zweihoch4,zweihoch7);
  2123.           end;
  2124.           hilf:= hilf div 2;
  2125.           if odd(hilf) then
  2126.                          drehen(zaehler,zweihoch5,zweihoch8); 
  2127.           end;
  2128.        else if randoben='no_slip' then
  2129.           hilf := Rote_Blaue_Teilchen[zaehler] div zweihoch2;
  2130.           if odd(hilf) then
  2131.                          drehen(zaehler,zweihoch2,zweihoch8); 
  2132.           end;
  2133.           hilf := hilf div 2;
  2134.           if odd(hilf) then
  2135.                          drehen(zaehler,zweihoch3,zweihoch9); 
  2136.           end;
  2137.           hilf:= hilf div 2;
  2138.           if odd(hilf) then
  2139.                          drehen(zaehler,zweihoch4,zweihoch10); 
  2140.           end;
  2141.           hilf:= hilf div 2;
  2142.           if odd(hilf) then
  2143.                          drehen(zaehler,zweihoch5,zweihoch11);
  2144.           end;
  2145.           end;
  2146.        end;
  2147.      end;
  2148.  
  2149.  
  2150.  
  2151.      if string='linksw' then
  2152.           hilf := Rote_Blaue_Teilchen[zaehler] div zweihoch4;
  2153.           if odd(hilf) then
  2154.                          drehen(zaehler,zweihoch4,zweihoch2); 
  2155.           end;
  2156.            hilf := hilf div 2;
  2157.           if odd(hilf) then
  2158.                          drehen(zaehler,zweihoch5,zweihoch3); 
  2159.           end;
  2160.      end;
  2161.  
  2162.  
  2163.  
  2164.  
  2165.      if string='links' then
  2166.        if randlinks='free_slip' then
  2167.           hilf := Rote_Blaue_Teilchen[zaehler] div zweihoch4;
  2168.           if odd(hilf) then
  2169.                          drehen(zaehler,zweihoch4,zweihoch2); 
  2170.           end;
  2171.           hilf := hilf div 2;
  2172.           if odd(hilf) then
  2173.                          drehen(zaehler,zweihoch5,zweihoch3); 
  2174.           end;
  2175.           hilf:= hilf div 2;
  2176.           if odd(hilf) then 
  2177.                          drehen(zaehler,zweihoch6,1);
  2178.           end;
  2179.           hilf:= hilf div 2;
  2180.           if odd(hilf) then
  2181.                          drehen(zaehler,zweihoch7,2); 
  2182.           end;
  2183.           hilf:= hilf div 2;
  2184.           if odd(hilf) then
  2185.                          drehen(zaehler,zweihoch8,zweihoch10); 
  2186.           end;
  2187.           hilf:= hilf div 2;
  2188.           if odd(hilf) then
  2189.                          drehen(zaehler,zweihoch9,zweihoch11); 
  2190.           end;
  2191.        else if randlinks='no_slip' then
  2192.           hilf := Rote_Blaue_Teilchen[zaehler] div zweihoch4;
  2193.           if odd(hilf) then 
  2194.                          drehen(zaehler,zweihoch4,zweihoch10);
  2195.           end;
  2196.           hilf := hilf div 2;
  2197.           if odd(hilf) then
  2198.                          drehen(zaehler,zweihoch5,zweihoch11); 
  2199.           end;
  2200.           hilf:= hilf div 2;
  2201.           if odd(hilf) then 
  2202.                          drehen(zaehler,zweihoch6,1);
  2203.           end;
  2204.           hilf:= hilf div 2;
  2205.           if odd(hilf) then
  2206.                          drehen(zaehler,zweihoch7,2); 
  2207.           end;
  2208.           hilf:= hilf div 2;
  2209.           if odd(hilf) then
  2210.                          drehen(zaehler,zweihoch8,zweihoch2); 
  2211.           end;
  2212.           hilf:= hilf div 2;
  2213.           if odd(hilf) then
  2214.                          drehen(zaehler,zweihoch9,zweihoch3); 
  2215.           end;
  2216.         end;
  2217.        end;
  2218.      end;
  2219.  
  2220.  
  2221.     if string='rechtsw' then
  2222.          hilf := Rote_Blaue_Teilchen[zaehler];
  2223.          if odd(hilf) then
  2224.                          drehen(zaehler,1,zweihoch6); 
  2225.          end;
  2226.          hilf := hilf div 2;
  2227.          if odd(hilf) then
  2228.                          drehen(zaehler,2,zweihoch7); 
  2229.          end;
  2230.     end;
  2231.  
  2232.  
  2233.  
  2234.  
  2235.      if string='rechts' then
  2236.        if randrechts='free_slip' then
  2237.           hilf := Rote_Blaue_Teilchen[zaehler];
  2238.           if odd(hilf) then
  2239.                          drehen(zaehler,1,zweihoch6); 
  2240.           end;
  2241.           hilf := hilf div 2;
  2242.           if odd(hilf) then
  2243.                          drehen(zaehler,2,zweihoch7); 
  2244.           end;
  2245.           hilf:= hilf div 2;
  2246.           if odd(hilf) then 
  2247.                          drehen(zaehler,zweihoch2,zweihoch4);
  2248.           end;
  2249.           hilf:= hilf div 2;
  2250.           if odd(hilf) then
  2251.                          drehen(zaehler,zweihoch3,zweihoch5); 
  2252.           end;
  2253.           hilf:= hilf div zweihoch7;
  2254.           if odd(hilf) then
  2255.                          drehen(zaehler,zweihoch10,zweihoch8); 
  2256.           end;
  2257.           hilf:= hilf div 2;
  2258.           if odd(hilf) then
  2259.                          drehen(zaehler,zweihoch11,zweihoch9); 
  2260.           end;
  2261.        else if randrechts='no_slip' then    
  2262.           hilf := Rote_Blaue_Teilchen[zaehler];
  2263.           if odd(hilf) then
  2264.                          drehen(zaehler,1,zweihoch6); 
  2265.           end;
  2266.           hilf := hilf div 2;
  2267.           if odd(hilf) then 
  2268.                          drehen(zaehler,2,zweihoch7);
  2269.           end;
  2270.           hilf:= hilf div 2;
  2271.           if odd(hilf) then
  2272.                          drehen(zaehler,zweihoch2,zweihoch8); 
  2273.           end;
  2274.           hilf:= hilf div 2;
  2275.           if odd(hilf) then
  2276.                          drehen(zaehler,zweihoch3,zweihoch9); 
  2277.           end;
  2278.           hilf:= hilf div zweihoch7;
  2279.           if odd(hilf) then
  2280.                          drehen(zaehler,zweihoch10,zweihoch4); 
  2281.           end;
  2282.           hilf:= hilf div 2;
  2283.           if odd(hilf) then
  2284.                          drehen(zaehler,zweihoch11,zweihoch5); 
  2285.           end;
  2286.          end;
  2287.        end;
  2288.      end; 
  2289.  
  2290.  
  2291. end Randbehandlung;
  2292.  
  2293.  
  2294.  
  2295.  
  2296.  
  2297. (****************************************************************************)
  2298. (***                                                                      ***)
  2299. (***      Prozedur Kollision:                                             ***)
  2300. (***          produces a new state using colour field and old state       ***)
  2301. (***                                                                      ***)
  2302. (****************************************************************************)
  2303.  
  2304.  
  2305. procedure kollision(scalar randoben,randunten,randlinks,randrechts : string10);
  2306.  
  2307.  
  2308.    vector impuls                                : impulstyp;
  2309.           impuls_x,   impuls_y,    zufall       : integer;
  2310.           richtung,   richtungneu,
  2311.           roteT,      blaueT,
  2312.           teilchennummer,          impulsnummer,
  2313.           teilimpnummer,           teilimphilf,
  2314.           kolfeldnummer,           positionhilf,
  2315.           ausgangszustand,         endpos,
  2316.           ausgangsposition,        gleiche,
  2317.           ausganghilf,             zaehler      : cardinal; 
  2318.           listenposition                        : integer;
  2319.           wo                                    : stringtyp;
  2320.           randbereich                           : boolean;
  2321.           
  2322.  
  2323.  
  2324. begin
  2325.   
  2326.     parallel
  2327.  
  2328.        randbereich := false; 
  2329.  
  2330.        for zaehler := 1 to vfakt do
  2331.  
  2332.           if not(streq(randunten,"'RING'")) and (DIM1 = 0) and (vfakt-vfaktx <= zaehler) then
  2333.              Randbehandlung('unten',zaehler);
  2334.              randbereich := true;
  2335.           end;
  2336.           if not(streq(randoben,"'RING'")) and (DIM1 = maxnet-1) and (zaehler <= vfaktx) then
  2337.               Randbehandlung('oben',zaehler);
  2338.               randbereich := true;
  2339.           end;
  2340.           if not(streq(randlinks,"'RING'")) and (DIM2 = 0) and (zaehler mod vfaktx = 1) then
  2341.               if (DIM1 mod 2 = 0) then
  2342.                   Randbehandlung('links',zaehler);
  2343.                   randbereich := true;
  2344.               else Randbehandlung('linksw',zaehler);
  2345.                    randbereich := true;
  2346.               end;
  2347.           end;
  2348.           if not(streq(randrechts,"'RING'")) and (DIM2 = maxnet-1) and (zaehler mod vfaktx = 0) then
  2349.               if (DIM1 mod 2 = 1) then
  2350.                   Randbehandlung('rechts',zaehler);
  2351.                   randbereich := true;
  2352.               else Randbehandlung('rechtsw',zaehler);
  2353.                    randbereich := true;
  2354.               end;
  2355.           end;
  2356.  
  2357.          if not(randbereich) then       
  2358.         
  2359.            (* Farbfeld berechnen *)
  2360.            (*writestring('Farbfeld berechnen');*)
  2361.            (*writeln;*)
  2362.            richtung:=Farbfeld(zaehler);
  2363.  
  2364.            (*writestring('Farbfeld berechnen Ende');*)
  2365.            (*writeln;*)
  2366.  
  2367.  
  2368.            (*Farbfeld in gewuenschte Position drehen *)
  2369.            (*writestring('Rotieren');*)
  2370.            (*writeln;*)
  2371.  
  2372.   
  2373.            RotateFarbfeld(richtung,richtungneu,zaehler);
  2374.  
  2375.  
  2376.            (*writestring('Rotieren Ende');*)
  2377.            (*writeln;*)
  2378.  
  2379.  
  2380.            (* Impuls berechnen *)
  2381.            impuls:= Impulsberechnung(zaehler);
  2382.               impuls_x:=impuls.impuls_x;
  2383.               impuls_y:=impuls.impuls_y;
  2384.  
  2385.  
  2386.  
  2387.            (* rote und blaue Teilchen *)
  2388.            roteT  := anzahlrotblau[zaehler] div offset6;
  2389.            blaueT := anzahlrotblau[zaehler] - roteT * offset6;
  2390.  
  2391.            (* Teilchenzuordnung *)
  2392.            teilchennummer := teilchenfeldall[blaueT][roteT];
  2393.  
  2394.            (* Impulsfeldzuordnung *)
  2395.            impulsnummer := impulsfeldall[impuls_x][impuls_y];
  2396.  
  2397.            (* Nummer Zustand zuordnen *)
  2398.            teilimpnummer := teilimpfeldall[impulsnummer][teilchennummer];
  2399.  
  2400.  
  2401.  
  2402.            (* Position in der Kollisionstabelle bestimmen *) 
  2403.            positionhilf := richtungneu;
  2404.  
  2405.            if richtungneu=5 then positionhilf:=3;
  2406.               else
  2407.                  if richtungneu>1 then 
  2408.                             positionhilf:= richtungneu-1;
  2409.                  end;
  2410.            end;
  2411.             
  2412.            teilimphilf := teilimpnummer div 2;
  2413.  
  2414.       
  2415.            if odd(teilimpnummer) then inc(teilimphilf);end;
  2416.  
  2417.  
  2418.            kolfeldnummer := kolfeldall[positionhilf][teilimphilf];
  2419.  
  2420.  
  2421.            (* kolfeldnummer decodieren *)
  2422.            if odd(teilimpnummer) then
  2423.                                    kolfeldnummer := kolfeldnummer div offset15;
  2424.                                   else
  2425.                                    ausganghilf := kolfeldnummer div offset15;
  2426.                                    kolfeldnummer := kolfeldnummer - (ausganghilf * offset15);
  2427.                                   end;
  2428.  
  2429.  
  2430.            ausgangsposition := kolfeldnummer div offset4;
  2431.            gleiche := kolfeldnummer - (ausgangsposition * offset4);
  2432.  
  2433.  
  2434.                         
  2435.            if ausgangsposition > 0 then
  2436.                                      zufall := 0;
  2437.                                      if gleiche > 1 then
  2438.                                             zufall := virandom();
  2439.                                             zufall := zufall mod gleiche;
  2440.  
  2441.                                      end;
  2442.                                      endpos := ausgangsposition + zufall;
  2443.                                      listenposition := endpos div 2;
  2444.                                      if even(endpos) then dec(listenposition);end;
  2445.                                      ausgangszustand:= zustandstaball[listenposition];
  2446.                                      ausganghilf := ausgangszustand div offset15;
  2447.                                      if even(endpos) then  
  2448.                                             ausganghilf:= ausgangszustand - ausganghilf * offset15;
  2449.                                      end;
  2450.                                      Rote_Blaue_Teilchen[zaehler] := ausganghilf;
  2451.  
  2452.            end;
  2453.  
  2454.            (* Zustand wieder in Originalzustand zurueckdrehen *)
  2455.            ReRotateFarbfeld(richtung,richtungneu,zaehler);
  2456.  
  2457.        end; (* if *)
  2458.  
  2459.      end; (*for*)
  2460.  
  2461.  
  2462.     endparallel; 
  2463.  
  2464.  
  2465. end kollision;
  2466.  
  2467.  
  2468.  
  2469.  
  2470.  
  2471.  
  2472. (****************************************************************************)
  2473. (***                                                                      ***)
  2474. (***      Prozedur filefind                                               ***)
  2475. (***          find a new name for output files                            ***)
  2476. (***                                                                      ***)
  2477. (****************************************************************************)
  2478.  
  2479.  
  2480.   procedure filefind ( scalar var string : string80; scalar welches : integer);
  2481.  
  2482.  
  2483.   scalar findestelle : cardinal;
  2484.     
  2485.  
  2486.   begin
  2487.  
  2488.  
  2489.      if welches = 0 then
  2490.        filestring := schnappschussausgabe;
  2491.        filezaehlerhilf := filezaehlers;
  2492.        findestelle := 1;
  2493.        while (findestelle < 80) and 
  2494.              ((ord(filestring[findestelle]) < 48) or (ord(filestring[findestelle]) > 58)) do
  2495.             inc(findestelle);
  2496.        end;
  2497.        filestring[findestelle] := chr(filezaehlers div 1000 +48);
  2498.        filezaehlers := filezaehlers - (filezaehlers div 1000 * 1000);
  2499.        filestring[findestelle+1] := chr(filezaehlers div 100 +48);
  2500.        filezaehlers := filezaehlers - (filezaehlers div 100 * 100);
  2501.        filestring[findestelle+2] := chr(filezaehlers div 10 +48);
  2502.        filezaehlers := filezaehlers - (filezaehlers div 10 * 10);
  2503.        filestring[findestelle+3] := chr(filezaehlers +48);
  2504.        filezaehlers := filezaehlerhilf;
  2505.        inc(filezaehlers);
  2506.      end;
  2507.      if welches = 1 then
  2508.        filestring := rotblauausgabe;
  2509.        filezaehlerhilf := filezaehlerrb;
  2510.        findestelle := 1;
  2511.        while (findestelle < 80) and 
  2512.              ((ord(filestring[findestelle]) < 48) or (ord(filestring[findestelle]) > 58)) do
  2513.             inc(findestelle);
  2514.        end;
  2515.        filestring[findestelle] := chr(filezaehlerrb div 1000 +48);
  2516.        filezaehlerrb := filezaehlerrb - (filezaehlerrb div 1000 * 1000);
  2517.        filestring[findestelle+1] := chr(filezaehlerrb div 100 +48);
  2518.        filezaehlerrb := filezaehlerrb - (filezaehlerrb div 100 * 100);
  2519.        filestring[findestelle+2] := chr(filezaehlerrb div 10 +48);
  2520.        filezaehlerrb := filezaehlerrb - (filezaehlerrb div 10 * 10);
  2521.        filestring[findestelle+3] := chr(filezaehlerrb +48);
  2522.        filezaehlerrb := filezaehlerhilf;
  2523.        inc(filezaehlerrb);
  2524.      end;
  2525.      if welches = 2 then
  2526.        filestring := vektorausgabe;
  2527.        filezaehlerhilf := filezaehlerv;
  2528.        findestelle := 1;
  2529.        while (findestelle < 80) and 
  2530.              ((ord(filestring[findestelle]) < 48) or (ord(filestring[findestelle]) > 58)) do
  2531.             inc(findestelle);
  2532.        end;
  2533.        filestring[findestelle] := chr(filezaehlerv div 1000 +48);
  2534.        filezaehlerv := filezaehlerv - (filezaehlerv div 1000 * 1000);
  2535.        filestring[findestelle+1] := chr(filezaehlerv div 100 +48);
  2536.        filezaehlerv := filezaehlerv - (filezaehlerv div 100 * 100);
  2537.        filestring[findestelle+2] := chr(filezaehlerv div 10 +48);
  2538.        filezaehlerv := filezaehlerv - (filezaehlerv div 10 * 10);
  2539.        filestring[findestelle+3] := chr(filezaehlerv +48);
  2540.        filezaehlerv := filezaehlerhilf;
  2541.        inc(filezaehlerv);
  2542.      end;
  2543.  
  2544.  
  2545.   end filefind;
  2546.  
  2547.  
  2548.  
  2549.  
  2550.  
  2551.  
  2552.  
  2553.  
  2554. (****************************************************************************)
  2555.  
  2556.   procedure anzahl_rotblau;
  2557.  
  2558.  
  2559.    vector summerot,summeblau,rbzaehler: cardinal;
  2560.  
  2561.  
  2562.    begin
  2563.     
  2564.      parallel
  2565.        (* Initialisierung *)
  2566.        for rbzaehler := 1 to vfakt do
  2567.          anzahlrotblau[rbzaehler] := 0;
  2568.        end;
  2569.  
  2570.        for rbzaehler := 1 to vfakt do
  2571.           summerot := AnzahlroteTeilchen(rbzaehler);
  2572.           summeblau := AnzahlblaueTeilchen(rbzaehler);
  2573.           anzahlrotblau[rbzaehler] := summerot * offset6 + summeblau;
  2574.        end; 
  2575.       endparallel;
  2576.  
  2577.    end anzahl_rotblau;
  2578.  
  2579.  
  2580.  
  2581.  
  2582.  
  2583.  
  2584.  
  2585.  
  2586.  
  2587.  
  2588. (****************************************************************************)
  2589.  
  2590.   procedure dichte(scalar zaehlerd: cardinal);
  2591.  
  2592.    vector rot,blau  : cardinal;
  2593.           dichterot,dichteblau : real;
  2594.  
  2595.  
  2596.    begin
  2597.  
  2598.      parallel
  2599.  
  2600.             rot  := anzahlrotblau[zaehlerd] div offset6;
  2601.             blau := anzahlrotblau[zaehlerd] - rot * offset6;
  2602.  
  2603.             dichterot := float(rot)/7.;
  2604.             dichteblau:= float(blau)/7.;
  2605.  
  2606.  
  2607.             (* irgendwie ausgeben *)
  2608.  
  2609.      endparallel;
  2610.  
  2611.    end dichte;
  2612.  
  2613.  
  2614. (****************************************************************************)
  2615.  
  2616.  
  2617. procedure geschwindigkeit(scalar string : string80;
  2618.                           scalar anzahlgemitteltx,anzahlgemittelty : cardinal);
  2619.  
  2620.  
  2621.    vector hilfteil,             hilfteilhalb,
  2622.           xrichtung,            yrichtung,
  2623.           anzahlteile,          rot, 
  2624.           blau,                 teilchenzaehler                  : cardinal;
  2625.           hilfsgeschwindigkeitx,            hilfsgeschwindigkeity,
  2626.           uebergabegeschwindigkeitx,        uebergabegeschwindigkeity,
  2627.           geschwx,                          geschwy              :real;
  2628.           vektorenxy            : array[1..vfakt] of vectortyp;
  2629.        
  2630.           
  2631.    scalar zaehlerg,         hilf5,          hilf1,   
  2632.           hilf2,            hilf4,          hilf3 ,
  2633.           offset,           index,          
  2634.           hilf6,            zaehler     :integer;
  2635.           zeilex,           ergebnisx,      ergebnisy,    
  2636.           zeiley          : array[0..maxnet-1] of real;          
  2637.           hilf7           : real;
  2638.       
  2639.  
  2640.    begin
  2641.  
  2642.      parallel
  2643.         
  2644.  
  2645.       for zaehlerg := 1 to vfakt do      
  2646.  
  2647.         geschwx := 0.;
  2648.         geschwy := 0.;
  2649.         uebergabegeschwindigkeitx := 0.;
  2650.         uebergabegeschwindigkeity := 0.;
  2651.  
  2652.         hilfteil := Rote_Blaue_Teilchen[zaehlerg];
  2653.         hilfteilhalb := hilfteil div 2;
  2654.  
  2655.         if odd(hilfteil) or odd(hilfteilhalb) then 
  2656.                                geschwx := geschwx + 1.;end;
  2657.  
  2658.         hilfteil := hilfteilhalb div 2;
  2659.         hilfteilhalb := hilfteil div 2;
  2660.  
  2661.         if odd(hilfteil) or odd(hilfteilhalb) then 
  2662.                                geschwx := geschwx + 0.5;
  2663.                                geschwy := geschwy + wurzeldreidurch2;end;
  2664.  
  2665.         
  2666.         hilfteil := hilfteilhalb div 2;
  2667.         hilfteilhalb := hilfteil div 2;
  2668.  
  2669.         if odd(hilfteil) or odd(hilfteilhalb) then 
  2670.                                geschwx := geschwx - 0.5;
  2671.                                geschwy := geschwy + wurzeldreidurch2;end;
  2672.  
  2673.         hilfteil := hilfteilhalb div 2;
  2674.         hilfteilhalb := hilfteil div 2;
  2675.  
  2676.         if odd(hilfteil) or odd(hilfteilhalb) then 
  2677.                                geschwx := geschwx - 1.;end;
  2678.         
  2679.         hilfteil := hilfteilhalb div 2;
  2680.         hilfteilhalb := hilfteil div 2;
  2681.  
  2682.         if odd(hilfteil) or odd(hilfteilhalb) then 
  2683.                                geschwx := geschwx - 0.5;
  2684.                                geschwy := geschwy - wurzeldreidurch2;end;
  2685.  
  2686.         hilfteil := hilfteilhalb div 2;
  2687.         hilfteilhalb := hilfteil div 2;
  2688.  
  2689.         if odd(hilfteil) or odd(hilfteilhalb) then 
  2690.                                geschwx := geschwx + 0.5;
  2691.                                geschwy := geschwy - wurzeldreidurch2;end;
  2692.  
  2693.  
  2694.         rot  := anzahlrotblau[zaehlerg] div offset6;
  2695.         blau := anzahlrotblau[zaehlerg] - rot * offset6;
  2696.         anzahlteile := rot + blau;
  2697.         if anzahlteile<>0 then
  2698.              uebergabegeschwindigkeitx := geschwx / float(anzahlteile);
  2699.              uebergabegeschwindigkeity := geschwy / float(anzahlteile);
  2700.           else uebergabegeschwindigkeitx := 0.0;
  2701.                uebergabegeschwindigkeity := 0.0;
  2702.         end;
  2703.       
  2704. (*        for xrichtung := 0 to anzahlgemitteltx-2 do
  2705.  
  2706.            hilfsgeschwindigkeitx := 0.;
  2707.            hilfsgeschwindigkeity := 0.;
  2708.            propagate.rechts(uebergabegeschwindigkeitx,hilfsgeschwindigkeitx);
  2709.            propagate.rechts(uebergabegeschwindigkeity,hilfsgeschwindigkeity);
  2710.            if (dim2 mod anzahlgemitteltx) = xrichtung +1 then 
  2711.                      uebergabegeschwindigkeitx := uebergabegeschwindigkeitx + hilfsgeschwindigkeitx;
  2712.                      uebergabegeschwindigkeity := uebergabegeschwindigkeity + hilfsgeschwindigkeity;
  2713.            end;
  2714.  
  2715.         end;
  2716.  
  2717.         for yrichtung := 0 to anzahlgemittelty-2 do
  2718.  
  2719.            hilfsgeschwindigkeitx := 0.;
  2720.            hilfsgeschwindigkeity := 0.;
  2721.            if yrichtung mod 2 = 0 then
  2722.              if (((dim2 mod anzahlgemitteltx)= anzahlgemitteltx-1) and
  2723.                 ((dim1 mod anzahlgemittelty)= anzahlgemittelty - 1 - yrichtung)) or
  2724.                 (((dim2 mod anzahlgemitteltx)= anzahlgemitteltx-1) and
  2725.                 ((dim1 mod anzahlgemittelty)= anzahlgemittelty - 2 - yrichtung)) then 
  2726.                           propagate.unten_rechts(uebergabegeschwindigkeitx,hilfsgeschwindigkeitx);
  2727.                           propagate.unten_rechts(uebergabegeschwindigkeity,hilfsgeschwindigkeity);
  2728.              end;
  2729.            end;
  2730.            if yrichtung mod 2 = 1 then
  2731.              if (((dim2 mod anzahlgemitteltx)= anzahlgemitteltx-1) and
  2732.                 ((dim1 mod anzahlgemittelty)= anzahlgemittelty - 2 - yrichtung)) or
  2733.                 (((dim2 mod anzahlgemitteltx)= anzahlgemitteltx-1) and
  2734.                 ((dim1 mod anzahlgemittelty)= anzahlgemittelty - 3 - yrichtung)) then 
  2735.  
  2736.                           propagate.unten_links(uebergabegeschwindigkeitx,hilfsgeschwindigkeitx);
  2737.                           propagate.unten_links(uebergabegeschwindigkeity,hilfsgeschwindigkeity);
  2738.              end;
  2739.            end;
  2740.            uebergabegeschwindigkeitx := uebergabegeschwindigkeitx + hilfsgeschwindigkeitx;
  2741.            uebergabegeschwindigkeity := uebergabegeschwindigkeity + hilfsgeschwindigkeity;
  2742.  
  2743.         end; *)
  2744.  
  2745.         vektorenxy[zaehlerg].x_Richtung := uebergabegeschwindigkeitx;
  2746.         vektorenxy[zaehlerg].y_Richtung := uebergabegeschwindigkeity; 
  2747.  
  2748.      end;
  2749.  
  2750.    endparallel;
  2751.  
  2752.  
  2753.      openoutput(string);
  2754.      if not(DONE) then errorhandle(1);end;
  2755.         
  2756.         write('V');
  2757.         write('F');
  2758.         write('F');
  2759.         write('A');
  2760.  
  2761.         hilf1 := virtuellepesx div anzahlgemitteltx;
  2762.         writecard(hilf1,5);
  2763.  
  2764.         hilf1 := virtuellepesy div anzahlgemittelty;
  2765.         writecard(hilf1,5);
  2766.  
  2767.         writecard(anzahlgemitteltx,5);
  2768.  
  2769.         write(EOL);
  2770.  
  2771. (*     parallel
  2772.  
  2773.      for hilf2 := 0 to vfakty - 1 do
  2774.         hilf4 := hilf2*vfaktx;
  2775.         hilf1 := maxnet - anzahlgemittelty;
  2776.         while hilf1>=0 do
  2777.           if ((maxnet-1)- DIM1) = hilf1 then 
  2778.              (*if DIM2 mod anzahlgemitteltx = (anzahlgemitteltx-1) then*)
  2779.                 for zaehlerg := 1 to vfaktx do
  2780.                       hilf5 := hilf4 + zaehlerg;
  2781.                       hilf3 := anzahlgemitteltx-1;
  2782.                       while hilf3 < maxnet do
  2783.                            if (DIM2 = hilf3) then
  2784.                               writereal(vektorenxy[hilf5].x_Richtung,6);
  2785.                               writereal(vektorenxy[hilf5].y_Richtung,6);
  2786.                            end;
  2787.                            hilf3 := hilf3 + anzahlgemitteltx;
  2788.                       end;
  2789.                  end;
  2790.             (* end;*)
  2791.            end;
  2792.           hilf1 := hilf1 - anzahlgemittelty;
  2793.         end;
  2794.      end;
  2795.      endparallel; *)
  2796.  
  2797.  
  2798.  
  2799.  
  2800.      for hilf1 := 1 to vfakty do
  2801.        offset := (hilf1-1) * vfakty;
  2802.  
  2803.        hilf2:=0;
  2804.        while hilf2< maxnet do
  2805.  
  2806.           for hilf3 := 1 to vfaktx do
  2807.               zaehler := 0;
  2808.               while zaehler < maxnet do
  2809.                   ergebnisx[zaehler] := 0.;
  2810.                   ergebnisy[zaehler] := 0.;
  2811.                   inc(zaehler);
  2812.               end;
  2813.  
  2814.  
  2815.              for hilf6 := 1 to anzahlgemittelty do
  2816.                parallel
  2817.                   if (dim1 = (maxnet-hilf6-hilf2)) then
  2818.                      store(vektorenxy[hilf3+offset].x_Richtung, zeilex);
  2819.                      store(vektorenxy[hilf3+offset].y_Richtung, zeiley);
  2820.                   end;
  2821.                endparallel;
  2822.              
  2823.                hilf4:=1;
  2824.                hilf5:= anzahlgemitteltx-1;
  2825.                zaehler := hilf5 - hilf4;
  2826.                while zaehler>0 do
  2827.                   while hilf5<maxnet do
  2828.                       zeilex[hilf5] := zeilex[hilf4]+zeilex[hilf5];
  2829.                       zeiley[hilf5] := zeiley[hilf4]+zeiley[hilf5];
  2830.                       hilf4:= hilf4 + anzahlgemitteltx;
  2831.                       hilf5:= hilf5 + anzahlgemitteltx;
  2832.                   end;
  2833.                   inc(hilf4);
  2834.                   hilf5:= anzahlgemitteltx-1;
  2835.                   zaehler := hilf5 - hilf4;
  2836.                end;
  2837.                zaehler:= anzahlgemitteltx-1;
  2838.                while zaehler < maxnet do
  2839.                   ergebnisx[zaehler] := ergebnisx[zaehler] + zeilex[zaehler];
  2840.                   ergebnisy[zaehler] := ergebnisy[zaehler] + zeiley[zaehler];
  2841.                   zaehler:=zaehler+anzahlgemitteltx;
  2842.                end;
  2843.              end;
  2844.              zaehler:= anzahlgemitteltx-1;
  2845.              while zaehler < maxnet do
  2846.                   writereal(ergebnisx[zaehler] ,4);
  2847.                   writestring(' ');
  2848.                   writereal(ergebnisy[zaehler] ,4);
  2849.                   writeln;
  2850.                   zaehler:=zaehler+anzahlgemitteltx;
  2851.              end;
  2852.           end;
  2853.           hilf2 := hilf2 + anzahlgemittelty;
  2854.         end;    
  2855.      end;
  2856.  
  2857.  
  2858.  
  2859.  
  2860.      closeoutput; 
  2861.  
  2862.  
  2863.   
  2864.  
  2865.                        
  2866.  end geschwindigkeit;                             
  2867.  
  2868.  
  2869.  
  2870.  
  2871.  
  2872.  
  2873. (****************************************************************************)
  2874.  
  2875.  
  2876.  
  2877. procedure pruefe();
  2878.  
  2879.  
  2880.    vector rot,          blau,        hilfz,
  2881.           zaehler1                       : cardinal;
  2882.           feld  : array [1..14]    of cardinal; 
  2883.           hilfp : array [1..vfakt] of cardinal; 
  2884.           
  2885.  
  2886.    scalar rote,         blaue,       hilfs,
  2887.           anzahl,       zaehlerp      : cardinal;
  2888.           anzahlrb     : array[1..14] of cardinal; 
  2889.  
  2890.  
  2891.    begin
  2892.  
  2893.         rote := 0;
  2894.         blaue := 0;
  2895.       
  2896.         for zaehlerp := 1 to vfakt do
  2897.            parallel
  2898.              rot  := anzahlrotblau[zaehlerp] div offset6;
  2899.              blau := anzahlrotblau[zaehlerp] - rot * offset6; 
  2900.            endparallel;
  2901.             rote := rote + reduce.sum(rot);
  2902.             blaue := blaue + reduce.sum(blau);
  2903.          end;
  2904.          writestring('Rote Teilchen insgesamt: ');
  2905.          writecard(rote,10);
  2906.          writeln;
  2907.          writestring('Blaue Teilchen insgesamt: ');
  2908.          writecard(blaue,10);
  2909.          writeln;
  2910.  
  2911.          hilfs := 1;
  2912.  
  2913.  
  2914.  
  2915.          parallel
  2916.              for zaehler1 := 1 to 14 do
  2917.                 feld[zaehler1] := 0;
  2918.              end;
  2919.              for zaehler1 := 1 to vfakt do
  2920.                 hilfp[zaehler1] := Rote_Blaue_Teilchen[zaehler1];
  2921.              end;
  2922.              for hilfz := 1 to 7 do
  2923.                  for zaehler1 := 1 to vfakt do
  2924.                      if odd(hilfp[zaehler1]) then inc(feld[2*(hilfz) -1]);end;
  2925.                      hilfp[zaehler1] := hilfp[zaehler1] div 2;
  2926.                      if odd(hilfp[zaehler1]) then inc(feld[2*hilfz]);end;
  2927.                      hilfp[zaehler1] := hilfp[zaehler1] div 2;
  2928.                  end;
  2929.              end;
  2930.              for hilfz := 1 to 14 do
  2931.                  anzahlrb[hilfs] := reduce.sum(feld[hilfz]);
  2932.                  inc(hilfs);
  2933.              end;
  2934.          endparallel;
  2935.  
  2936.  
  2937.  
  2938.          for hilfs := 1 to 14 do
  2939.              if odd(hilfs) then writestring('Anzahl blauer Teilchen in Richtung ');
  2940.                                     writecard((hilfs+1) div 2,3);
  2941.                                     writestring('  :');
  2942.                                     writecard(anzahlrb[hilfs],7);
  2943.                                     writeln;
  2944.                            else writestring('Anzahl roter Teilchen in Richtung  ');
  2945.                                     writecard((hilfs) div 2,3);
  2946.                                     writestring('  : ');
  2947.                                     writecard(anzahlrb[hilfs],7);
  2948.                                     writeln;
  2949.              end;
  2950.          end;
  2951.                                       
  2952.  
  2953.    end pruefe;
  2954.          
  2955.        
  2956.  
  2957.  
  2958.  
  2959.  
  2960. (****************************************************************************)
  2961. (***                                                                      ***)
  2962. (***      Prozedur errorhandle                                            ***)
  2963. (***          zur Fehlerbehandlung                                        ***)
  2964. (***                                                                      ***)
  2965. (****************************************************************************)
  2966.  
  2967. procedure errorhandle (scalar fehler : integer);
  2968.  
  2969.  
  2970.  begin
  2971.  
  2972.  
  2973.         case fehler of 
  2974.              
  2975.              1 : writestring('Ausgabedatei laesst sich nicht oeffnen !');
  2976.                  writeln;
  2977.                  halt;   |
  2978.              2 : writestring('Eingabedatei laesst sich nicht oeffnen !');
  2979.                  writeln;
  2980.                  halt;   |
  2981.              3 : writestring('Ausgabedatei laesst sich nicht schliessen !');
  2982.                  writeln;
  2983.                  halt;   |
  2984.              4 : writestring('Fehler im Inputfile !!!');
  2985.                  writeln;
  2986.                  halt;   |
  2987.              5 : writestring('Falsche Dimensionsangabe des Gitters !');
  2988.                  writeln;
  2989.                  halt;
  2990.          end;
  2991.  
  2992.  
  2993.  end errorhandle;
  2994.  
  2995. (****************************************************************************)
  2996.  
  2997.  
  2998.  
  2999.   procedure inputfileeinlesen(scalar var anzahlblasen,flaechen : cardinal;
  3000.        scalar var geschwu0,geschwv0,reddichte,anteilrot : real;
  3001.        scalar var geschwx,geschwy,dichtebl :real10;
  3002.        scalar var radius,mittelpunktx,mittelpunkty: card10;
  3003.        scalar var randoben,randunten,randrechts,randlinks : string10;
  3004.        scalar var rechtecklinksuntenx,rechtecklinksunteny,rechteckseitea,
  3005.                   rechteckseiteb: card10;
  3006.        scalar var dichteblr,geschwxr,geschwyr : real10;
  3007.        scalar var anfangszeitpunkt,endzeitpunkt,bildabstand,
  3008.                   bildabstandgesch,erstesbild,erstesdruckbild : cardinal;
  3009.        scalar var anzahlgemitteltx,anzahlgemittelty : cardinal);
  3010.  
  3011.  
  3012.  
  3013.    scalar eingabepuffer : string80;
  3014.           varname       : string10;
  3015.  
  3016.           virtpeesx,               virtpeesy,
  3017.           tmp,                     zaehler,                 
  3018.           temp,
  3019.           ueberlappx,              timeout,
  3020.           ueberlappy               : cardinal;
  3021.  
  3022.     begin
  3023.  
  3024.       (* Initialisierung *)
  3025.       geschwu0 := 0.;         geschwv0 := 0.;    reddichte := 0.;
  3026.       anteilrot := 0.;  
  3027.       for zaehler := 1 to 10 do
  3028.           geschwx[zaehler] := 0.;        geschwy[zaehler] := 0.;
  3029.           dichtebl[zaehler] := 0.;       radius[zaehler] := 0;
  3030.           mittelpunktx[zaehler] := 0;    mittelpunkty[zaehler] := 0;
  3031.       end;
  3032.       
  3033.       openinput(inputfile);
  3034.       openoutput(controlfile);
  3035.  
  3036.       (* Kommentare ueberlesen *) 
  3037.       writestring('*****************************************************************');
  3038.       writeln;
  3039.       writestring('*                                                               *');
  3040.       writeln;
  3041.       writestring('* Inputfile for simulating a immiscible Fluids based on the     *');
  3042.       writeln;
  3043.       writestring('* Lattice Gas Method                                            *');
  3044.       writeln;
  3045.       writestring('*                                                               *');
  3046.       writeln;
  3047.       writestring('*****************************************************************');
  3048.       writeln;writeln;writeln;
  3049.  
  3050.       timeout := 0;
  3051.       repeat
  3052.         readstring(eingabepuffer);
  3053.         inc(timeout);
  3054.         if timeout = 100000 then errorhandle(4);end;
  3055.       until strcmp(eingabepuffer , ">>>BEGINN") = 0 ;
  3056.       writestring(eingabepuffer);
  3057.       writeln;
  3058.  
  3059.       (* Titel des Programmlaufes lesen *)
  3060.       timeout := 0;
  3061.       repeat
  3062.         readstring(eingabepuffer);
  3063.         inc(timeout);
  3064.         if timeout = 100000 then errorhandle(4);end;
  3065.       until ((eingabepuffer[1] = 'T') and (eingabepuffer[2] = 'I') and (eingabepuffer[3] = 'T') and
  3066.              (eingabepuffer[4] = 'E') and (eingabepuffer[5] = 'L'));
  3067.       writeln;
  3068.       writestring(eingabepuffer);
  3069.       writestring(' ');
  3070.  
  3071.       readstring(eingabepuffer); 
  3072.  
  3073.       (* Gittergroesse lesen *)
  3074.       timeout := 0;
  3075.       repeat
  3076.         writestring(eingabepuffer);
  3077.         writestring(' ');
  3078.         readstring(eingabepuffer);
  3079.         inc(timeout);
  3080.         if timeout = 100000 then errorhandle(4);end;
  3081.       until ((eingabepuffer[1] = 'G') and (eingabepuffer[2] = 'I') and (eingabepuffer[3] = 'T') and
  3082.              (eingabepuffer[4] = 'T') and (eingabepuffer[5] = 'E') and (eingabepuffer[6] = 'R'));
  3083.       writeln;writeln;
  3084.       writestring(eingabepuffer);
  3085.       writestring(' ');
  3086.       readstring(varname);
  3087.       writeln;
  3088.  
  3089.       if streq(varname,"'IMAX") then 
  3090.             writestring('IMAX   ');
  3091.             readstring(varname);
  3092.             readcard(virtpeesx);
  3093.             writecard(virtpeesx,12);
  3094.             (* if virtpeesx <> virtuellepesx then errorhandle(5);end;*)
  3095.       end;
  3096.  
  3097.       writestring('      GROESSE DES GITTERS IN X-RICHTUNG ');
  3098.       writeln;
  3099.       timeout := 0;
  3100.       repeat
  3101.          readstring(eingabepuffer);
  3102.          inc(timeout);
  3103.          if timeout = 100000 then errorhandle(4);end;
  3104.       until streq(eingabepuffer,"'JMAX");
  3105.       writestring('JMAX   ');
  3106.  
  3107.       readstring(eingabepuffer); 
  3108.  
  3109.       readcard(virtpeesy);
  3110.       writecard(virtpeesy,12);
  3111.       (* if virtpeesy <> virtuellepesy then errorhandle(5);end;*)
  3112.       writestring('      GROESSE DES GITTERS IN Y-RICHTUNG ');
  3113.       writeln;writeln;
  3114.  
  3115.       (* Anfangsbedingungen der Stroemung *)
  3116.       timeout := 0;
  3117.       repeat      
  3118.          readstring(eingabepuffer);
  3119.          inc(timeout);
  3120.          if timeout = 100000 then errorhandle(4);end;
  3121.       until ((eingabepuffer[1] = 'A') and (eingabepuffer[2] = 'N') and (eingabepuffer[3] = 'F') and
  3122.              (eingabepuffer[4] = 'A') and (eingabepuffer[5] = 'N') and (eingabepuffer[6] = 'G'));
  3123.  
  3124.       timeout := 0;
  3125.       repeat
  3126.            writestring(eingabepuffer);writestring(' ');
  3127.            readstring(eingabepuffer);
  3128.            inc(timeout);
  3129.            if timeout = 100000 then errorhandle(4);end;
  3130.       until streq(eingabepuffer,"'BLASEN");
  3131.       writeln;
  3132.  
  3133.       writestring('BLASEN ');
  3134.       readstring(varname);
  3135.       readcard(anzahlblasen);
  3136.       writecard(anzahlblasen,12);
  3137.       writestring('      NUMBER OF BLUE DROPLETS');writeln;
  3138.  
  3139.       (* Anzahl der Flaechen noch wichtig *)
  3140.       timeout := 0;
  3141.       repeat 
  3142.          readstring(eingabepuffer);
  3143.          inc(timeout);
  3144.          if timeout = 100000 then errorhandle(4);end;
  3145.       until streq(eingabepuffer,"'FLAECHE='");
  3146.       writestring('FLAECHE');
  3147.       readcard(flaechen);
  3148.       writecard(flaechen,12);
  3149.       writestring('      NUMBER OF BLUE  ');
  3150.       writeln;writeln;
  3151.  
  3152.       if (flaechen=0) and (anzahlblasen=0) then
  3153.         timeout := 0;
  3154.         repeat
  3155.           readstring(eingabepuffer);
  3156.           inc(timeout);
  3157.           if timeout = 100000 then errorhandle(4);end;
  3158.         until ((eingabepuffer[1] = 'M') and (eingabepuffer[2] = 'I') and (eingabepuffer[3] = 'S') and
  3159.                (eingabepuffer[4] = 'C') and (eingabepuffer[5] = 'H') and (eingabepuffer[6] = 'U'));
  3160.  
  3161.         writeln;writeln;
  3162.         writestring(eingabepuffer);writeln;
  3163.  
  3164.         (* Mischungsphase *)
  3165.         timeout := 0;
  3166.         repeat
  3167.            readstring(eingabepuffer);
  3168.            inc(timeout);
  3169.            if timeout = 100000 then errorhandle(4);end;
  3170.         until streq(eingabepuffer,"'U0E");
  3171.         writestring('U0E      ');
  3172.         readstring(eingabepuffer);
  3173.          
  3174.         readreal(geschwu0);
  3175.         writereal(geschwu0,12);
  3176.         writestring('    VELOCITY IN X-DIRECTION');writeln;
  3177.  
  3178.         timeout := 0;
  3179.         repeat
  3180.            readstring(eingabepuffer);
  3181.            inc(timeout);
  3182.            if timeout = 100000 then errorhandle(4);end;
  3183.         until streq(eingabepuffer,"'V0E");
  3184.         
  3185.         readstring(varname);
  3186.         writestring('V0E      '); 
  3187.         readreal(geschwv0);
  3188.         writereal(geschwv0,12);
  3189.         writestring('    VELOCITY Y-DIRECTION');
  3190.         writeln;
  3191.      
  3192.         timeout := 0;
  3193.         repeat
  3194.            readstring(eingabepuffer);
  3195.            inc(timeout);
  3196.            if timeout = 100000 then errorhandle(4);end;
  3197.         until streq(eingabepuffer,"'D0E");
  3198.         writestring('D0E      ');
  3199.         readstring(varname);
  3200.         readreal(reddichte);
  3201.         writereal(reddichte,12);
  3202.         writestring('    DICHTE FOR EACH CELL');writeln;
  3203.  
  3204.         timeout := 0; 
  3205.         repeat
  3206.            readstring(eingabepuffer);
  3207.            inc(timeout);
  3208.            if timeout = 100000 then errorhandle(4);end;
  3209.         until streq(eingabepuffer,"'AROT");
  3210.         writestring('AROT     ');
  3211.         readstring(varname); 
  3212.         readreal(anteilrot);
  3213.         writereal(anteilrot,12);
  3214.         writestring('    RED PARTICLES FACTOR');writeln;
  3215.    
  3216.       end;
  3217.  
  3218.  
  3219.       if anzahlblasen>0 then
  3220.         
  3221.          for zaehler := 1 to anzahlblasen do
  3222.              writeln;
  3223.              timeout := 0;
  3224.              repeat
  3225.                 readstring(eingabepuffer);
  3226.                 inc(timeout);
  3227.                 if timeout = 100000 then errorhandle(4);end;
  3228.              until ((eingabepuffer[1] = 'B') and (eingabepuffer[2] = 'L') and (eingabepuffer[3] = 'A') and
  3229.                     (eingabepuffer[4] = 'S') and (eingabepuffer[5] = 'E'));
  3230.              writestring(eingabepuffer);writestring(' ');
  3231.              writecard(zaehler,2);writeln;
  3232.              timeout := 0;
  3233.              repeat
  3234.                readstring(eingabepuffer);
  3235.                inc(timeout);
  3236.                if timeout = 100000 then errorhandle(4);end;
  3237.              until streq(eingabepuffer,"'U0");
  3238.              readstring(varname);
  3239.              writestring('U0      ');
  3240.              readreal(geschwx[zaehler]);
  3241.              writereal(geschwx[zaehler],12);
  3242.              writestring('     VELOCITY OF DROPLET IN X');writeln;
  3243.              timeout := 0;
  3244.              repeat
  3245.                   readstring(eingabepuffer);
  3246.                   inc(timeout);
  3247.                   if timeout = 100000 then errorhandle(4);end;
  3248.              until streq(eingabepuffer,"'V0");
  3249.              writestring('V0      ');
  3250.              readstring(varname);
  3251.              readreal(geschwy[zaehler]);
  3252.              writereal(geschwy[zaehler],12);
  3253.              writestring('     VELOCITY OF DROPLET IN Y');
  3254.              writeln;
  3255.              timeout := 0;
  3256.              repeat
  3257.                   readstring(eingabepuffer);
  3258.                   inc(timeout);
  3259.                   if timeout = 100000 then errorhandle(4);end;
  3260.              until streq(eingabepuffer,"'DBLAU");
  3261.              writestring('DBLAU   ');
  3262.              readstring(varname);
  3263.              readreal(dichtebl[zaehler]);
  3264.              writereal(dichtebl[zaehler],12);
  3265.              writestring('     GESAMTBELEGUNGSDICHTE OF THE BLUE DROPLET');
  3266.              writeln;
  3267.  
  3268.              timeout := 0;
  3269.              repeat
  3270.                   readstring(eingabepuffer);
  3271.                   inc(timeout);
  3272.                   if timeout = 100000 then errorhandle(4);end;
  3273.              until streq(eingabepuffer,"'RADIUS");
  3274.              writestring('RADIUS  ');
  3275.              readstring(varname);
  3276.              readcard(radius[zaehler]);
  3277.              writecard(radius[zaehler],12);
  3278.              writestring('     RADIUS DER BLASE ');writeln;
  3279.  
  3280.              timeout := 0;
  3281.              repeat
  3282.                   readstring(eingabepuffer);
  3283.                   inc(timeout);
  3284.                   if timeout = 100000 then errorhandle(4);end;
  3285.              until streq(eingabepuffer,"'XPOS");
  3286.              writestring('XPOS    ');
  3287.           
  3288.              readstring(varname);
  3289.              readcard(mittelpunktx[zaehler]);
  3290.              writecard(mittelpunktx[zaehler],12);
  3291.              writestring('     MITTELPUNKT OF THE DROPLET IN X');
  3292.              writeln;
  3293.              timeout := 0;
  3294.              repeat
  3295.                   readstring(eingabepuffer);
  3296.                   inc(timeout);
  3297.                   if timeout = 100000 then errorhandle(4);end;
  3298.              until streq(eingabepuffer,"'YPOS");
  3299.              writestring('YPOS    ');
  3300.              readstring(varname);
  3301.              readcard(mittelpunkty[zaehler]);
  3302.              writecard(mittelpunkty[zaehler],12);
  3303.              writestring('     MITTELPUNKT OF THE DROPLET IN Y');
  3304.              writeln;
  3305.           end;
  3306.  
  3307.       end;
  3308.  
  3309.       if flaechen>0 then
  3310.  
  3311.          for zaehler := 1 to flaechen do
  3312.              writeln;
  3313.              timeout := 0;
  3314.              repeat
  3315.                 readstring(eingabepuffer);
  3316.                 inc(timeout);
  3317.                 if timeout = 100000 then errorhandle(4);end;
  3318.              until ((eingabepuffer[1] = 'F') and (eingabepuffer[2] = 'L') and (eingabepuffer[3] = 'A') and
  3319.                     (eingabepuffer[4] = 'E') and (eingabepuffer[5] = 'C'));
  3320.              writestring(eingabepuffer);writeln;
  3321.             
  3322.              timeout := 0; 
  3323.              repeat
  3324.                   readstring(eingabepuffer);
  3325.                   inc(timeout);
  3326.                   if timeout = 100000 then errorhandle(4);end;
  3327.              until streq(eingabepuffer,"'NX");
  3328.              writestring('NX      ');
  3329.              readstring(varname);
  3330.              readcard(rechtecklinksuntenx[zaehler]);
  3331.              writecard(rechtecklinksuntenx[zaehler],12);
  3332.              writestring('       BEGINN DER FLAECHE IN X-RICHTUNG');writeln;
  3333.              
  3334.              timeout := 0;
  3335.              repeat
  3336.                   readstring(eingabepuffer);
  3337.                   inc(timeout);
  3338.                   if timeout = 100000 then errorhandle(4);end;
  3339.              until streq(eingabepuffer,"'DX");
  3340.              writestring('DX      ');readstring(varname);
  3341.              readcard(rechteckseitea[zaehler]);
  3342.              writecard(rechteckseitea[zaehler],12);
  3343.              writestring('       BREITE DER FLAECHE IN X-RICHTUNG');writeln; 
  3344.              
  3345.              timeout := 0;
  3346.              repeat
  3347.                   readstring(eingabepuffer);
  3348.                   inc(timeout);
  3349.                   if timeout = 100000 then errorhandle(4);end;
  3350.              until streq(eingabepuffer,"'NY");
  3351.              writestring('NY      ');readstring(varname);
  3352.              readcard(rechtecklinksunteny[zaehler]);
  3353.              writecard(rechtecklinksunteny[zaehler],12);
  3354.              writestring('    BEGINN DER FLAECHE IN Y-RICHTUNG');writeln;  
  3355.  
  3356.              timeout := 0;
  3357.              repeat
  3358.                   readstring(eingabepuffer);
  3359.                   inc(timeout);
  3360.                   if timeout = 100000 then errorhandle(4);end;
  3361.              until streq(eingabepuffer,"'DY");
  3362.              writestring('DY      ');readstring(varname);
  3363.              readcard(rechteckseiteb[zaehler]);
  3364.              writecard(rechteckseiteb[zaehler],12);
  3365.              writestring('     BREITE DER FLAECHE IN Y-RICHTUNG');writeln;
  3366.              
  3367.              timeout := 0;
  3368.              repeat
  3369.                   readstring(eingabepuffer);
  3370.                   inc(timeout);
  3371.                   if timeout = 100000 then errorhandle(4);end;
  3372.              until streq(eingabepuffer,"'DBL");
  3373.              writestring('DBL       ');readstring(varname);
  3374.              readreal(dichteblr[zaehler]);
  3375.              writereal(dichteblr[zaehler],12);
  3376.              writestring('   GESAMTBELEGUNGSDICHTE DER BLAUEN FLAECHE');writeln;
  3377.  
  3378.  
  3379.  
  3380.              (* No use : ueberlesen *);
  3381.              timeout := 0;
  3382.              repeat
  3383.                   readstring(eingabepuffer);
  3384.                   inc(timeout);
  3385.                   if timeout = 100000 then errorhandle(4);end;
  3386.              until streq(eingabepuffer,"'GSCHWV");
  3387.              readstring(varname);
  3388.             
  3389.              timeout := 0; 
  3390.              repeat
  3391.                   readstring(eingabepuffer);
  3392.                   inc(timeout);
  3393.                   if timeout = 100000 then errorhandle(4);end;
  3394.              until streq(eingabepuffer,"'LWELB");
  3395.              readstring(varname);
  3396.              readcard(tmp);
  3397.              
  3398.              timeout := 0;
  3399.              repeat
  3400.                   readstring(eingabepuffer);
  3401.                   inc(timeout);
  3402.                   if timeout = 100000 then errorhandle(4);end;
  3403.              until streq(eingabepuffer,"'U0B");
  3404.              writestring('U0B       ');
  3405.              readstring(varname);
  3406.              readreal(geschwxr[zaehler]);
  3407.              writereal(geschwxr[zaehler],12);
  3408.              writestring('   GESCHWINDIGKEIT DER FLAECHE IN X');writeln;
  3409.  
  3410.              timeout := 0;
  3411.              repeat
  3412.                   readstring(eingabepuffer);
  3413.                   inc(timeout);
  3414.                   if timeout = 100000 then errorhandle(4);end;
  3415.              until streq(eingabepuffer,"'V0B");
  3416.              writestring('V0B       ');
  3417.              readstring(varname);
  3418.              readreal(geschwyr[zaehler]);
  3419.              writereal(geschwyr[zaehler],12);
  3420.              writestring('   GESCHWINDIGKEIT DER FLAECHE IN Y');writeln;
  3421.  
  3422.           end;
  3423.  
  3424.       end;
  3425.  
  3426.       (* Berechnungszeitraum etc. einlesen *)
  3427.       timeout := 0;
  3428.       repeat
  3429.          readstring(eingabepuffer);
  3430.          inc(timeout);
  3431.          if timeout = 100000 then errorhandle(4);end;
  3432.       until ((eingabepuffer[1] = 'B') and (eingabepuffer[2] = 'E') and (eingabepuffer[3] = 'R') and
  3433.              (eingabepuffer[4] = 'E') and (eingabepuffer[5] = 'C'));
  3434.  
  3435.       writeln;writestring(eingabepuffer);writeln;
  3436.  
  3437.  
  3438.       timeout := 0;
  3439.       repeat
  3440.           readstring(eingabepuffer);
  3441.           inc(timeout);
  3442.           if timeout = 100000 then errorhandle(4);end;
  3443.       until streq(eingabepuffer,"'IT0");
  3444.       writestring('IT0     ');
  3445.       readstring(varname);
  3446.       readcard(anfangszeitpunkt);
  3447.       writecard(anfangszeitpunkt,12);
  3448.       writestring('     ANFANGSZEITPUNKT DER BERECHNUNG');writeln;
  3449.  
  3450.       timeout := 0;
  3451.       repeat
  3452.           readstring(eingabepuffer);
  3453.           inc(timeout);
  3454.           if timeout = 100000 then errorhandle(4);end;
  3455.       until streq(eingabepuffer,"'ITDIF");
  3456.       writestring('ITDIF   ');
  3457.       readstring(varname);
  3458.       readcard(endzeitpunkt);
  3459.       writecard(endzeitpunkt,12);
  3460.       writestring('     ANZAHL DER BERECHNETEN ZEITPUNKTE');writeln;
  3461.  
  3462.       timeout := 0;
  3463.       repeat
  3464.           readstring(eingabepuffer);
  3465.           inc(timeout);
  3466.           if timeout = 100000 then errorhandle(4);end;
  3467.       until streq(eingabepuffer,"'BLDA");
  3468.       writestring('BLDA    ');
  3469.       readstring(varname);
  3470.       readcard(erstesbild);
  3471.       writecard(erstesbild,12);
  3472.       writestring('     ZEITPUNKT DES ERSTEN BILDES');writeln;
  3473.       
  3474.       timeout := 0;
  3475.       repeat
  3476.           readstring(eingabepuffer);
  3477.           inc(timeout);
  3478.           if timeout = 100000 then errorhandle(4);end;
  3479.       until streq(eingabepuffer,"'BLPRDA");
  3480.       writestring('BLPRDA  ');
  3481.       readstring(varname);
  3482.       readcard(erstesdruckbild);
  3483.       writecard(erstesdruckbild,12);
  3484.       writestring('     ZEITPUNKT DES ERSTES DRUCKBILDES');writeln;
  3485.  
  3486.       timeout := 0;
  3487.       repeat
  3488.           readstring(eingabepuffer);
  3489.           inc(timeout);
  3490.           if timeout = 100000 then errorhandle(4);end;
  3491.       until streq(eingabepuffer,"'BLDWER");
  3492.       writestring('BLDWER  ');
  3493.       readstring(varname);
  3494.       readcard(bildabstand);
  3495.       writecard(bildabstand,12);
  3496.       writestring('     ZEITDIFFERENZ DER BILDER');writeln;
  3497.       
  3498.       timeout := 0;
  3499.       repeat
  3500.           readstring(eingabepuffer);
  3501.           inc(timeout);
  3502.           if timeout = 100000 then errorhandle(4);end;
  3503.       until streq(eingabepuffer,"'BLDDF");
  3504.       writestring('BLDDF   ');
  3505.       readstring(varname);
  3506.       readcard(bildabstandgesch);
  3507.       writecard(bildabstandgesch,12);
  3508.       writestring('     ZEITDIFFERENZ DER DRUCKBILDER');writeln;
  3509.  
  3510.  
  3511.  
  3512.  
  3513.       (* Randbedingungen einlesen *)
  3514.       timeout := 0; 
  3515.       repeat
  3516.          readstring(eingabepuffer);
  3517.          inc(timeout);
  3518.          if timeout = 100000 then errorhandle(4);end;
  3519.       until ((eingabepuffer[1] = 'R') and (eingabepuffer[2] = 'A') and (eingabepuffer[3] = 'N') and
  3520.              (eingabepuffer[4] = 'D') and (eingabepuffer[5] = 'B'));
  3521.  
  3522.       writeln;writestring(eingabepuffer);writeln;
  3523.  
  3524.       timeout := 0;
  3525.       repeat
  3526.           readstring(eingabepuffer);
  3527.           inc(timeout);
  3528.           if timeout = 100000 then errorhandle(4);end;
  3529.       until streq(eingabepuffer,"'RDLI='");
  3530.       writestring('RDLI    ');
  3531.       readstring(randlinks);
  3532.       writestring(randlinks);
  3533.       writestring('     RANDBEDINGUNG LINKS');writeln;
  3534.  
  3535.       timeout := 0;
  3536.       repeat
  3537.           readstring(eingabepuffer);
  3538.           inc(timeout);
  3539.           if timeout = 100000 then errorhandle(4);end;
  3540.       until streq(eingabepuffer,"'RDRE='");
  3541.       writestring('RDRE    ');
  3542.       readstring(randrechts);
  3543.       writestring(randrechts);
  3544.       writestring('     RANDBEDINGUNG RECHTS');writeln;
  3545.  
  3546.       timeout := 0;
  3547.       repeat
  3548.           readstring(eingabepuffer);
  3549.           inc(timeout);
  3550.           if timeout = 100000 then errorhandle(4);end;
  3551.       until streq(eingabepuffer,"'RDOB='");
  3552.       writestring('RDOB    ');
  3553.       readstring(randoben);
  3554.       writestring(randoben);
  3555.       writestring('     RANDBEDINGUNG OBEN');writeln;
  3556.  
  3557.       timeout := 0;
  3558.       repeat
  3559.           readstring(eingabepuffer);
  3560.           inc(timeout);
  3561.           if timeout = 100000 then errorhandle(4);end; 
  3562.       until streq(eingabepuffer,"'RDUN='");
  3563.       writestring('RDUN    ');
  3564.       readstring(randunten);
  3565.       writestring(randunten);
  3566.       writestring('     RANDBEDINGUNG UNTEN');writeln;
  3567.  
  3568.    
  3569.  
  3570.       (* Mittelwerte einlesen *)
  3571.       timeout := 0;
  3572.       repeat
  3573.          readstring(eingabepuffer);
  3574.          inc(timeout);
  3575.          if timeout = 100000 then errorhandle(4);end;
  3576.       until ((eingabepuffer[1] = 'M') and (eingabepuffer[2] = 'I') and (eingabepuffer[3] = 'T') and
  3577.              (eingabepuffer[4] = 'T') and (eingabepuffer[5] = 'E'));
  3578.  
  3579.       writeln;writestring(eingabepuffer);writeln;
  3580.  
  3581.  
  3582.       timeout := 0;
  3583.       repeat
  3584.           readstring(eingabepuffer);
  3585.           inc(timeout);
  3586.           if timeout = 100000 then errorhandle(4);end;
  3587.       until streq(eingabepuffer,"'NXK='");
  3588.       writestring('NXK     ');
  3589.       readcard(anzahlgemitteltx);
  3590.       writecard(anzahlgemitteltx,12);
  3591.       writestring('     ANZAHL PUNKTE IN X-RICHTUNG');writeln;
  3592.       
  3593.       timeout := 0;
  3594.       repeat
  3595.           readstring(eingabepuffer);
  3596.           inc(timeout);
  3597.           if timeout = 100000 then errorhandle(4);end;
  3598.       until streq(eingabepuffer,"'NYK='");
  3599.       writestring('NYK     ');
  3600.       readcard(anzahlgemittelty);
  3601.       writecard(anzahlgemittelty,12);
  3602.       writestring('     ANZAHL PUNKTE IN Y-RICHTUNG');writeln;
  3603.  
  3604.       timeout := 0;
  3605.       repeat
  3606.           readstring(eingabepuffer);
  3607.           inc(timeout);
  3608.           if timeout = 100000 then errorhandle(4);end;
  3609.       until streq(eingabepuffer,"'NXU='");
  3610.       writestring('NXU     ');
  3611.       readcard(ueberlappx);
  3612.       writecard(ueberlappx,12);
  3613.       writestring('     UEBERLAPPUNG IN X-RICHTUNG');writeln;
  3614.  
  3615.       timeout := 0;
  3616.       repeat
  3617.           readstring(eingabepuffer);
  3618.           inc(timeout);
  3619.           if timeout = 100000 then errorhandle(4);end;
  3620.       until streq(eingabepuffer,"'NYU='");
  3621.       writestring('NYU     ');
  3622.       readcard(ueberlappy);
  3623.       writecard(ueberlappy,12);
  3624.       writestring('     UEBERLAPPUNG IN Y-RICHTUNG');writeln;
  3625.        
  3626.       writeln;
  3627.       writestring('>>>ENDE');
  3628.       writeln;
  3629.       writeln;writeln;
  3630.       writestring('Eingabedaten vollstaendig gelesen !!');
  3631.       writeln;
  3632.       for timeout := 1 to 10 do writeln;end;  
  3633.  
  3634.       closeoutput;
  3635.       closeinput; 
  3636.  
  3637.  
  3638.     end inputfileeinlesen;          
  3639.  
  3640.  
  3641.  
  3642.  
  3643.  
  3644.  
  3645.  
  3646.  
  3647.  
  3648.  
  3649.  
  3650.  
  3651.  
  3652.  
  3653.  
  3654.  
  3655.  
  3656.  
  3657. (****************************************************************************)
  3658.  
  3659. (*procedure bildschirmausgabe(scalar selekt : cardinal); 
  3660.  
  3661.   scalar  groessex,          groessey,
  3662.           offsetx,           offsety       : integer;
  3663.  
  3664.    
  3665.   vector  blau,              rot                : color;  
  3666.           hilf1,             roteT,    blaueT   : cardinal;   
  3667.  
  3668.  
  3669.   begin                        
  3670.     if selekt=0 then handle := OpenWindow(0.8,0.8);end;
  3671.  
  3672.  
  3673.     if selekt=1 then Selectwindow(handle);end;
  3674.  
  3675.  
  3676.  
  3677.    parallel
  3678.  
  3679.       (* Farbskala fuer Schwarzweissausgabe *)
  3680.       blau.red := 0;                     
  3681.       blau.green := 0;                   
  3682.       blau.blue := 0;        
  3683.       rot.red := max(cardinal);          
  3684.       rot.green := max(cardinal);                    
  3685.       rot.blue:=  max(cardinal); 
  3686.       offsetx := 0;
  3687.       offsety := 0;
  3688.   
  3689.  
  3690.        for hilf1 :=1 to vfakt do
  3691.  
  3692.           roteT  := anzahlrotblau[hilf1] div offset6;
  3693.           blaueT := anzahlrotblau[hilf1] - roteT * offset6;
  3694.      
  3695.           if roteT > blaueT  
  3696.                      then setcolor(blau);        
  3697.                      else setcolor(rot); end;
  3698.                   
  3699.           setpixel(dim1+offsetx,dim2+offsety);
  3700.  
  3701.           offsetx := offsetx + maxnet;
  3702.           if (hilf1 mod vfaktx) = 0 then offsetx := 0;
  3703.                                          offsety := offsety + maxnet;
  3704.           end;
  3705.        end;
  3706.  
  3707.  
  3708.     endparallel;  
  3709.                                                        
  3710.     if selekt=2 then CloseWindow(handle); end;                                              
  3711.   end bildschirmausgabe; *)                                                
  3712.  
  3713.  
  3714.  
  3715.  
  3716. (****************************************************************************)
  3717.  
  3718.  
  3719.  
  3720. begin
  3721.   
  3722.    filezaehlers  := 1;
  3723.    filezaehlerrb := 1;
  3724.    filezaehlerv  := 1;
  3725.    filezaehlerhilf := 0;
  3726.    inputfileeinlesen(anzahlblasen,flaechen,geschwu0,geschwv0,reddichte,anteilrot,
  3727.                      geschwx,geschwy,dichtebl,radius,mittelpunktx,mittelpunkty,
  3728.                      randoben,randunten,randrechts,randlinks,rechtecklinksuntenx,
  3729.                      rechtecklinksunteny,rechteckseitea,rechteckseiteb,
  3730.                      dichteblr,geschwxr,geschwyr,anfangszeitpunkt,endzeitpunkt,bildabstand,
  3731.                      bildabstandgesch,erstesbild,erstesbildgesch,
  3732.                      anzahlgemitteltx,anzahlgemittelty); 
  3733.  
  3734.    if anfangszeitpunkt=1 then
  3735.       writestring('initial state begin');
  3736.       writeln;
  3737.       anfangsbelegung(anzahlblasen,flaechen,geschwu0,geschwv0,reddichte,anteilrot,
  3738.                       geschwx,geschwy,dichtebl,radius,mittelpunktx,mittelpunkty,
  3739.                       randoben,randunten,randrechts,randlinks,rechtecklinksuntenx,
  3740.                       rechtecklinksunteny,rechteckseitea,rechteckseiteb,
  3741.                       dichteblr,geschwxr,geschwyr); 
  3742.       writestring('initial state end');
  3743.       writeln;
  3744.    else
  3745.      writestring('loading snapshot begin');
  3746.      writeln;
  3747.      aufsetzer_einlesen;
  3748.      writestring('loading snapshot end');
  3749.      writeln;
  3750.    end;
  3751.  
  3752.    anzahl_rotblau;
  3753.    pruefe;
  3754. (*   bildschirmausgabe(0); *)
  3755.  
  3756.    writestring('loading tables begin');
  3757.    writeln; 
  3758.    einlesen;
  3759.    writestring('loading tables end');
  3760.    writeln; 
  3761.    (* saving initial state*)
  3762.      writeln;
  3763.      filefind(filestring,1);
  3764.      writeln;
  3765.      ausgabe_rot_blau(filestring);
  3766.  
  3767.    for zaehlerglobal:= anfangszeitpunkt to endzeitpunkt do
  3768.       if (zaehlerglobal >= erstesbild) and
  3769.            (zaehlerglobal mod  bildabstand = 0) then
  3770.                                 writestring('counter   :');
  3771.                                 writecard(zaehlerglobal,5);
  3772.                                 writestring('  ');
  3773.                                 writeln;
  3774.                                 filefind(filestring,1);
  3775.                                 writeln;
  3776.                                 ausgabe_rot_blau(filestring);
  3777.                                 (*bildschirmausgabe(1);        *)
  3778.                              end;
  3779.        if (zaehlerglobal= erstesbildgesch) or 
  3780.            ((zaehlerglobal >= erstesbildgesch) and
  3781.             (zaehlerglobal mod  bildabstandgesch = 0)) then
  3782.                                 writestring('counter   :');
  3783.                                 writecard(zaehlerglobal,5);
  3784.                                 writestring('  ');
  3785.                                 filefind(filestring,2);
  3786.                                 geschwindigkeit(filestring,anzahlgemitteltx,anzahlgemittelty); 
  3787.                              end; 
  3788.      
  3789.        if zaehlerglobal mod 1000 = 0 then
  3790.                                      writestring('schnappshot begin');
  3791.                                      filefind(filestring,0);
  3792.                                      schnappschuss(filestring);
  3793.        end;
  3794.  
  3795.  
  3796.        anzahl_rotblau;
  3797.  
  3798.        kollision(randoben,randunten,randlinks,randrechts);
  3799.  
  3800.        fortbewegung;
  3801.   
  3802.    end;
  3803.    pruefe;
  3804. (*   bildschirmausgabe(2);*)
  3805.   
  3806. end ilg_10.
  3807.  
  3808.